Aligning login logout times horizontally

[caseyoconnor10]

I have a list of employee login/logout times that currently are in tw
columns. The employee has a shiftstart, firstbreaklogout
firstbreaklogin,lunchbreaklogout, lunchbreaklogin, secondbreaklogout
secondbreaklogin, and shiftend time. I need to be able to alig
horizontally into 8 columns the employees login/out times by date.

Current Data look like this

Date Login Logout
06/02/04 8:15AM 9:47AM
06/02/04 10:00AM 12:01PM
06/02/04 12:45PM 2:35PM
06/02/04 2:45PM 4:45PM
06/03/04 8:15AM 9:45AM
06/03/04 10:01AM 12:00PM
06/03/04 12:46PM 2:30PM
06/03/04 2:45PM 4:45PM
06/04/04 8:16AM 9:59AM
06/04/04 10:15AM 12:02PM
06/04/04 12:45PM 2:34PM
06/04/04 2:45PM 4:46PM

I would like it to look like this
06/02/04 8:15AM 9:47AM 10:00AM 12:01PM " " "
06/03/04 8:15AM 9:45AM 10:01AM 12:00PM " " "
06/04/04 8:16AM 9:59AM 10:15AM 12:02PM " " "

Im assuming the easiest way would be using IF statements to see if th
next row down in column A = the current selected row. Then move th
cell that is down and adjacent up to the next available row. It seem
to me I am making this way to difficult. Does anyone else have an
other ideas. I will appreciate any feedback

 

[caseyoconnor10]

You will have to forgive me, but could you elaborate a little bit fo
me. However, I really appreciate your respons

 

[Bob Phillips]

I didn't get all of your previous post, so it needs a bit more than that.
This code should do it

Sub TidyDates()
Dim cLastRow As Long
Dim rng As Range
Dim i As Long
Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 3 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "A").Offset(0, 1).Resize(1, 6).Copy
Destination:=Cells(i - 1, "A").Offset(0, 3)
If rng Is Nothing Then
Set rng = Cells(i, "A")
Else
Set rng = Union(rng, Cells(i, "A"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[caseyoconnor10]

Thanks for responding, I implemented the code above but I received
syntax error at line 19=>

Destination:=Cells(i - 1, "A").Offset(0, 3)

If I remove this portion, the script runs and removes all but one ro
of data for each date and only puts in the first login time. Atleast
am seeing progression, I am very greatful. I tried to change the synta
a little to see if I could get it to work, but no luck. I studied you
code a for a few hours and some what understand what you are doing
Here is the syntax again. Column A is the Date, Column B is the logi
time, and Column C is the logout time. Just to clarify is row 1 I d
have the heads "Date","Login", and "Logout". I was not sure if havin
column headings was throwing off your code. Either way I tried t
remove the Headings row and run the script, but still received th
same error. Thanks again for all your help

Sub TidyDates()
Dim cLastRow As Long
Dim rng As Range
Dim i As Long
Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 3 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "A").Offset(0, 1).Resize(1, 6).Copy
Destination:=Cells(i - 1, "A").Offset(0, 3)
If rng Is Nothing Then
Set rng = Cells(i, "A")
Else
Set rng = Union(rng, Cells(i, "A"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

End Su

 

[caseyoconnor10]

Thanks for responding, I implemented the code above but I received
syntax error at line 19=>

Destination:=Cells(i - 1, "A").Offset(0, 3)

If I remove this portion, the script runs and removes all but one ro
of data for each date and only puts in the first login time. Atleast
am seeing progression, I am very greatful. I tried to change the synta
a little to see if I could get it to work, but no luck. I studied you
code for a few hours and some what understand what you are doing. Her
is the syntax again. Column A is the Date, Column B is the login time
and Column C is the logout time. Just to clarify, row 1 I do have th
column headings of "Date","Login", and "Logout". I was not sure i
having column headings was throwing off your code. Either way I trie
to remove the Headings row and run the script, but still received th
same error. Thanks again for all your help

Sub TidyDates()
Dim cLastRow As Long
Dim rng As Range
Dim i As Long
Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 3 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "A").Offset(0, 1).Resize(1, 6).Copy
Destination:=Cells(i - 1, "A").Offset(0, 3)
If rng Is Nothing Then
Set rng = Cells(i, "A")
Else
Set rng = Union(rng, Cells(i, "A"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

End Su

 

[Bob Phillips]

Casey,

That'sNG wrap-around. Try this version

Sub TidyDates()
Dim cLastRow As Long
Dim rng As Range
Dim i As Long
Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 3 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "A").Offset(0, 1).Resize(1, 6).Copy _
Destination:=Cells(i - 1, "A").Offset(0, 3)
If rng Is Nothing Then
Set rng = Cells(i, "A")
Else
Set rng = Union(rng, Cells(i, "A"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[caseyoconnor10]

Bob,
I should have caught that missing underscore from the previous code
The code is showing some promising results, except now the last log i
time is being removed. I am going to look into what you have done her
and see if I can figure it out. Arrays are a little beyond my means bu
I am eager to learn. If you look at the current results below and yo
see a quick modification to the code that would resolve the last tim
being removed, I would greatly appreciate your input.....again....
really appreciate your time and knowledge. Below is how the data i
coming out now

Raw Date

Logout Date Login Time Logout Time
05/18/04 8:15AM 9:46AM
05/18/04 10:00AM 12:05PM
05/18/04 12:50PM 2:30PM
05/18/04 2:45PM 4:46PM
05/19/04 8:16AM 10:02AM
05/19/04 10:18AM 12:00PM
05/19/04 12:45PM 2:30PM
05/19/04 2:46PM 4:49PM
05/20/04 8:15AM 9:45AM
05/20/04 10:01AM 12:00PM
05/20/04 12:45PM 2:37PM
05/20/04 2:51PM 4:45PM

After your script is applied=> As you can see the last time is missing

05/18/04 8:15AM 10:00AM 12:50PM 2:45PM
05/19/04 8:16AM 10:18AM 12:45PM 2:46PM
05/20/04 8:15AM 10:01AM 12:45PM 2:51P

 

[Bob Phillips]

Not for me mate, it works perfectly and I get this

05/18/04 8:15AM 9:46AM 10:00AM 12:05PM 12:50PM 2:30PM 2:45PM 4:46PM
05/19/04 8:16AM 10:02AM 10:18AM 12:00PM 12:45PM 2:30PM 2:46PM 4:49PM
05/20/04 8:15AM 9:45AM 10:01AM 12:00PM 12:45PM 2:37PM 2:51PM 4:45PM


B y the way it wasn't a missing underscore, it was wrap-around caused by the
NG. If you put both lines on the same line it works just as well.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[caseyoconnor10]

Bob,
Can you take a look at the file I have attached. I must be confused,
have the code set up as a macro. The raw data is in the first sheet. I
you run the script within my document you will see the result I a
getting. I must be missing something, cause your results are exactl
what I want. Thanks for your extended help.

Case

Attachment filename: loginlogoutalign.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=58958

 

[Bob Phillips]

Casey,

I see it all now. When you said 2 columns, I interpreted that as one column
date, and 1 column for start and end time. Now I understand, try this
version of the code

Sub TidyDates()
Dim cLastRow As Long
Dim rng As Range
Dim i As Long

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 3 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "A").Offset(0, 1).Resize(1, 6).Copy _
Destination:=Cells(i - 1, "A").Offset(0, 3)
If rng Is Nothing Then
Set rng = Cells(i, "A")
Else
Set rng = Union(rng, Cells(i, "A"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[caseyoconnor10]

Bob,
Excellent...Just Excellent, that is all I can say. I ran with your cod
and made a few modifications to completely fix my issue. Here is what
did. Some employees take multiple breaks so the code needs to look fo
more login logout times, therefore I stretched the .Resize to 60 whic
expands the number of fields to the right. Then i also forgot th
employees name is also a field that sits to the left of the date fiel
so I shifted all the code to the right one cell. I was going to us
this code just for single employees, but I again made a different se
of changes and now I am able to fix all employees LoginLogout Times a
once. I want you to know you have really helped me excel in my VB
knowledge, helped me resolve this current issue, and inspired me t
learn even further in the field of programming. This is the first o
two parts of my problem with login/logout times, however I am going t
try and come up with a solution for the second part on my own.....Yo
were a huge help...Thank you

Casey

Here is my end result:

Employee 06/01/04 6:49AM 8:20AM 8:35AM 9:45A
10:30AM 1:41PM 1:59PM 3:16PM
Employee 06/02/04 6:52AM 8:18AM 8:34AM 9:57A
10:45AM 1:31PM 1:46PM 3:15PM
Employee 06/03/04 6:52AM 8:18AM 8:33AM 10:18AM
Employee 06/04/04 6:49AM 8:19AM 8:35AM 9:45A
10:31AM 1:32PM 1:47PM 3:15PM


Here is the changes I made below


Dim cLastRow As Long
Dim rng As Range
Dim i As Long

cLastRow = Cells(Rows.Count, "B").End(xlUp).Row
'The next line if set at 4 will make the 1st line of time return
For i = cLastRow To 3 Step -1
If Cells(i, "B").Value = Cells(i - 1, "B").Value Then
'.Offset moves the cell to the right 1 cell
'.Resize allows many cells to be opened at the right
Cells(i, "B").Offset(0, 1).Resize(1, 60).Copy _
Destination:=Cells(i - 1, "B").Offset(0, 5)
If rng Is Nothing Then
Set rng = Cells(i, "B")
Else
Set rng = Union(rng, Cells(i, "B"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End I

 

[Bob Phillips]

Hi Casey,

That's great. A solution, and a learning experience<G>.
Maybe you should add a computation of al the times, finish-start aggregated?

Do post back if you get stuck.

Bob