Coverting rows to column in date and time order

Topic

New Reply

Excel 2003, for now.

In Sheet 1 I have info. imported from a web page, another macro does some editing etc, no problems there.

Another macro is required so it turns out the way it is in Sheet 2
But also ending up in date and time order.

It can go as far as 350 rows down in Sheet 1 with 1 or 2 (maximum) blank
rows at various intervals.
So I have only provided a portion, because doing this
manually 250 rows plus, at times gets a bit tedious to say the least.

Can someone help with a macro so the info. ends up looking like it does in
Sheet 2, time and date order please

Notice in Sheet 2, rows 43-47 I have hi-lited to show the time and date order can go to
midnight and onto the next day’s date.

The time and date order obviously needs to be from the AM to PM

Thanks in advance, much appreciated.

Reply | Quote

Replies

XP,

This code will copy data to a sheet called Sorted in the format you specified, however, it will arrange the name groups alphabetically (Primary criteria) and then by date/time (Secondary Criteria). There is no limitations to the number of columns or rows so it will grow accordingly. The blank cells will be disregarded. There is 1 instance of Sheet1 and 6 instances of Sorted in the code that need to be changed to the names of the actual sheets used.

HTH,
Maud

Code:

Public Sub ReArrange()
Worksheets(“Sheet1”).Activate
Row = 3
With Worksheets(“Sorted”)
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For I = 3 To LastRow
    Lastcol = ActiveSheet.Cells(I, Application.Columns.Count).End(xlToLeft).Column
    For J = 4 To Lastcol
        If Cells(I, J).Value = “” Then GoTo Done
        .Cells(Row, 1).Value = Cells(I, 1).Value
        .Cells(Row, 2).Value = Cells(I, 2).Value
        .Cells(Row, 3).Value = J – 3
        .Cells(Row, 4).Value = Cells(I, 3).Value
        .Cells(Row, 5).Value = Cells(I, J).Value
        Row = Row + 1
Done:
    Next J
Next I
End With
Worksheets(“Sorted”).Activate
    Range(Cells(3, 1), Cells(Row, 5)).Select
    ActiveWorkbook.Worksheets(“Sorted”).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(“Sorted”).Sort.SortFields.Add Key:=Range(“D3:D57”) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(“Sorted”).Sort.SortFields.Add Key:=Range(“E3:E57”) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(“Sorted”).Sort
        .SetRange Range(Cells(3, 1), Cells(Row, 5))
        .Header = xlNo
        .Apply
    End With
Range(“A1”).Select

End Sub

Reply | Quote

Maudibe,

Thanks,

Have added a bit extra code for “cosmetics”.
I can live with having to do the the “midnite to next day’s date” Ascending Sort by cut and paste to bottom of list manually.
Other than that it’s a good as done for this part of a larger process.

Reply | Quote

XP,

Looking at your initial upload (Sheet2), I had thought you wanted to group by name and then by date/time, not just by time. Apologies

Reply | Quote

No Prob,

I have added another piece of code, this helps if anyone is required to delete unspecified
Rows with Loop, If, Then scenarios

Code:

Sub DeleteRow()

Sheets(“Sorted”).Select
Sheets(“Sorted”).Range(“E3”).Select
Do Until ActiveCell.Value = “”

            ‘current cell          Or cell to Right ( will NOT keep )                   canceled appointments
If ActiveCell.Value = “” Or ActiveCell.Offset(0, 1).Value = “” Or ActiveCell.Offset(0, 1).Value = “Cncld ” Then

‘current cell          Or cell to Right ( will KEEP )                                  canceled appointments
‘If ActiveCell.Value = “” Or ActiveCell.Offset(0, -1).Value = “” Or ActiveCell.Offset(0, 1).Value = “Cncld ” Then

ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
Loop

End Sub

PS
After posting, the long bits did not fit entirely on this forum, so it may look wrong due to
word wrapping here, but it works in the VBA Module.

Reply | Quote