View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein Rick Rothstein is offline
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

Here are slightly shorter versions of my code, one assuming the data in both
columns are in sorted order before the macro is run and the other allowing
the data to be sorted or not sorted...

'===================================
' Data Pre-sorted
'===================================
Sub AlignColumnData()
Dim M As Long, D As Long, Rw As Long, TempM As Long, Main, Data
With WorksheetFunction
Main = .Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row))
Data = .Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row))
Range("A:B").Clear
M = LBound(Main)
D = LBound(Data)
Do While M + D <= UBound(Main) + UBound(Data)
Rw = Rw + 1
Range("A" & Rw).Offset(0, -(Main(M) Data(D))).Resize(1, _
1 - (Main(M) = Data(D))) = .Min(Main(M), Data(D))
TempM = Main(M)
M = M - (Main(M) <= Data(D))
D = D - (TempM = Data(D))
Loop
End With
End Sub

'===================================
' Data Not Necessarily Sorted
'===================================
Sub AlignColumnData()
Dim M As Long, D As Long, Rw As Long, TempM As Long, Main, Data
Columns("A").Sort Range("A1"), xlAscending
Columns("B").Sort Range("B1"), xlAscending
With WorksheetFunction
Main = .Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row))
Data = .Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row))
Range("A:B").Clear
M = LBound(Main)
D = LBound(Data)
Do While M + D <= UBound(Main) + UBound(Data)
Rw = Rw + 1
Range("A" & Rw).Offset(0, -(Main(M) Data(D))).Resize(1, _
1 - (Main(M) = Data(D))) = .Min(Main(M), Data(D))
TempM = Main(M)
M = M - (Main(M) <= Data(D))
D = D - (TempM = Data(D))
Loop
End With
End Sub


Rick Rothstein (MVP - Excel)