Transpose Uneven Rows Into Matching Columns

[Tallonenx]

Hi all, here's another quandary I'm having in getting data to behave nice-

I have a dataset with dates and times things start and stop.
For Ex:

1/1/2017	12:01 AM	3:00 AM
	4:30 AM	9:00 AM
1/5/2017	1:00 PM	8:00 PM
1/6/2017	4:00 PM	8:00 PM
	12:30 PM	5:00 PM
	1:00 PM	2:00 PM
	9:00 AM	12:30 PM
1/12/2017	4:00 PM	8:00 PM
	11:00 PM	3:00 AM

<tbody>
</tbody>

There is no overall pattern with how many entries per date these things occur.
They can have as few as 1 or as many as entries as needed.


I'd like to take this data and turn it into this:

1/1/2017	1/5/2017	1/6/2017	1/12/2017
12:01 AM	1:00 PM	4:00 PM	4:00 PM
3:00 AM	8:00 PM	8:00 PM	8:00 PM
4:30 AM		12:30 PM	11:00 PM
9:00 AM		5:00 PM	3:00 AM
		1:00 PM
		2:00 PM
		9:00 PM
		12:30 PM

<tbody>
</tbody>

I've tried some transpose methods and so far they haven't worked.
They usually result completely losing the corresponding date or jumbled data:

<tbody></tbody>

1/1/2017		1/5/2017	1/6/2017
12:01 AM	4:30 AM	1:00 PM	4:00 PM	12:30 PM	1:00 PM	9:00 AM	4:00 PM	11:00 PM
3:00 AM	9:00 AM	8:00 PM	8:00 PM	5:00 PM	2:00 PM	12:30 PM	8:00 PM	3:00 AM

<colgroup><col><col><col><col span="2"><col><col><col span="2"></colgroup><tbody>
</tbody>

Any ideas on how to transpose these uneven rows & columns of data into matching columns,
according to the original date & keeping the time order intact?


-THANKS!

 

[Trebor76]

Hi Tallonenx,

This macro will do the job:

Option Explicit
Sub Macro1()

    Dim lngMyRow    As Long
    Dim lngLastRow  As Long
    Dim lngPasteCol As Long
    Dim lngPasteRow As Long
    Dim strPasteCol As String
    
    Application.ScreenUpdating = False

    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For lngMyRow = 2 To lngLastRow
        If Len(Range("A" & lngMyRow)) > 0 Then
            If lngPasteCol = 0 Then
                lngPasteCol = 5 'Initial output column (E in this case). Change to suit if neccessary.
            Else
                lngPasteCol = lngPasteCol + 1
            End If
            strPasteCol = Left(Cells(1, lngPasteCol).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngPasteCol).Address(True, False)) - 1)
            Range(strPasteCol & "2").Value = Format(Range("A" & lngMyRow), "mm/dd/yyyy") 'Header (date)
        End If
            Range(strPasteCol & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Range("B" & lngMyRow), "h:mm AM/PM")
            Range(strPasteCol & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Range("C" & lngMyRow), "h:mm AM/PM")
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[Tallonenx]

Thank you so much Trebor76.
I got it to work on one data set.



But then I got an error on the next try-

"Run Time Error 1004"
Method of Range Object '_Global" failed

Debug says that this line is the culprit...
End If
Range(strPasteCol & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Range("B" & lngMyRow), "h:mm AM/PM")


Not sure what I'm doing wrong :/

 

[Trebor76]

Not sure what I'm doing wrong

Me either I'm afraid

Check what value is being passed to the strPasteCol and lngMyRow variables as I suspect either one or both are not representing a valid column and row number (respectively) i.e. if strPasteCol = "XFE" (Excel 2007 and later) or lngMyRow = 0 you will get that message. I also coded the macro based on the assumption that the date and times were spread across columns A, B and C. This may not be case for each dataset.

HTH

Robert