Sorting multiple time data based on time value on column A

[Econsynergy]

Review the attachment. You'll see 2 sets of data, "What I have" and
"What I want". Of course, this is only a sample data, my actual data
sheet has over 10,000 rows and 25 columns.

The basic idea is to have some sort of script or formula where all the
time match in 1 row, yet the value stays the with time during sorting.

What I have
Time 1 Value 1 Time 2 Value 2 Time 3 Value 3
7:00 a 7:00 e 7:00 h
7:01 b 7:02 f 7:02 i
7:02 c 7:03 g
7:03 d

What I want
Time 1 Value 1 Time 2 Value 2 Time 3 Value 3
7:00 a 7:00 e 7:00 h
7:01 b
7:02 c 7:02 f 7:02 i
7:03 d 7:03 g

Please advise.

Thanks.

 

[Per Jessen]

Hi

Try this:

Sub SortTimeValues()
Dim StartRow As Long
Dim StartCol As String
Dim LastRow As Long
Dim cOff As Long
Dim tRow As Long

StartRow = 2 ' Headings i row 1
StartCol = "A"
LastRow = Cells(StartRow, StartCol).End(xlDown).Row

For Each cell In Range(StartCol & StartRow, StartCol & LastRow)
tTime = cell.Value
cOff = 2
Do Until Range(cell.Address).Offset(0, cOff).Value = ""
If cell.Offset(0, cOff).Value <> cell.Value Then
Range(cell.Address).Offset(0, cOff).Resize(1, 2).Cut _
Destination:=Range(cell.Address).Offset(1,
0).End(xlToRight).Offset(0, 1)
End If
cOff = cOff + 2

Loop
Next

For Each cell In Range(StartCol & StartRow, StartCol & LastRow)
cOff = 2
lastcol = Cells(cell.Row, Columns.Count).End(xlToLeft).Column
tRow = cell.Row
Do Until lastcol = cOff
If Cells(tRow, 1 + cOff).Value = "" Then
Cells(tRow, 3 + cOff).Resize(1, 2).Cut Destination:=Cells(tRow,
1 + cOff)
End If
cOff = cOff + 2
Loop
Next
End Sub

Regards,
Per

 

[Bernie Deitrick]

Econsynergy,

Try the macro below - I have assumed that you have exact matches for all the data, and that the time
values in each column do not repeat.

HTH,
Bernie
MS Excel MVP


Sub SortDataToMatch()
Dim i As Integer
Dim myR As Long
Dim myC As Integer

myC = Cells(2, Columns.Count).End(xlToLeft).Column

myR = Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To myC Step 2
Columns(i + 2).Insert
Columns(i + 2).Cells.NumberFormat = "General"
Cells(2, i + 2).Resize(myR - 1).FormulaR1C1 = "=MATCH(RC[-2],C1,FALSE)"
Cells(myR + 1, i + 2).Resize(myR - 1).FormulaR1C1 = _
"=IF(ISERROR(MATCH(ROW(R[-" & myR - 1 & "]C1),R2C" & i + 2 & _
":R" & myR & "C" & i + 2 & ",FALSE)),ROW(R[-" & myR - 1 & "]C1),NA())"
Columns(i + 1).Value = Columns(i + 1).Value
Columns(i).Resize(, 3).Sort Key1:=Cells(2, i + 2), Order1:=xlAscending, Header:=xlYes
Columns(i + 2).Delete
Next i

End Sub