View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

I tried this using your values and came up with the following result:

251120
251130
251140
251145
272505 272505
272535
291101
291130
292100 292100

The code...

Sub AlignLikeRows()
Dim rng1 As Range, rng2 As Range, c As Range, c1 As Range, c2 As
Range
Dim v As Variant

Set rng1 = Range("A:A"): Set rng2 = Range("B:B")
rng1.Sort key1:=rng1.Cells(1), order1:=xlAscending
rng2.Sort key1:=rng2.Cells(1), order1:=xlAscending

For Each c In rng2
If Not IsEmpty(c) Then
If Not c.Value = c.Offset(, -1).Value And _
Not c.Offset(, -1) = "" Then
If Not c.Value = v Then
v = c.Value: c = ""
Set c2 = rng1.Find(what:=v, _
after:=rng1.Cells(1), _
lookat:=xlWhole)
If Not c2 Is Nothing Then
c2.Offset(, 1).Insert shift:=xlDown
c2.Offset(, 1).Value = v
Else '//not found so insert it where it belongs
For Each c1 In rng1
If c1 v Then
c1.EntireRow.Insert: c1.Offset(-1, 1) = v: Exit For
End If
Next
End If
End If
End If
End If
Next
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc