I have a macro (below) that copys the address info. for each "group"
designated in column B to each "group member". This works but for some
reason I am losing the info. in the C column for the group members. I
am also lost on how to get this to work if there are additional columns
of information beyond F. Any ideas???

The code:
Sub FixData()
Dim Rng1 As Range, Rng2 As Range
Dim C As Range, DeleteRng As Range
Dim FirstAdd As String

Application.ScreenUpdating = False

Set Rng1 = ActiveSheet.Columns("B")
Set C = Rng1.Find("Group", LookIn:=xlValues)
If Not C Is Nothing Then
FirstAdd = C.Address
Set Rng2 = Range(C.Offset(, 1), C.Offset(, 5))
Do
Set C = C.Offset(1)
If LCase(Trim(C.Value)) = "group member" Then _
Range(C.Offset(, 1), C.Offset(, 4)) = Rng2.Value
Loop Until LCase(Trim(C.Value)) < "group member"
Set DeleteRng = Rng2.EntireRow
End If

Do
Set C = Rng1.FindNext(C)
If C.Address = FirstAdd Then Exit Do
Set Rng2 = Range(C.Offset(, 1), C.Offset(, 5))
Do
Set C = C.Offset(1)
If LCase(Trim(C.Value)) = "group member" Then _
Range(C.Offset(, 1), C.Offset(, 4)) = Rng2.Value
Loop Until LCase(Trim(C.Value)) < "group member"
Set DeleteRng = Union(DeleteRng, Rng2.EntireRow)
Loop While Not C Is Nothing
DeleteRng.Delete
Columns("B").EntireColumn.Delete

Application.ScreenUpdating = True

End Sub


Here is an example:
A B C D E F
1)[Name1] [data1][Address1][City1] [State1]
2)[Name2] "Group" [Address2][City2] [State2]
3)[Name3] "Group member" [data2]
4)[Name4] "Group member" [data3]
5)[Name5] "Group member" [data4]
6)[Name6] "Group member" [data5]
7)[Name7] [data6][Address3][City3] [State3]

Needed (after macro):
A B C D E
1)[Name1] [data1][Address1][City1] [State1]
3)[Name3] [data2][Address2][City2] [State2]
4)[Name4] [data3][Address2][City2] [State2]
5)[Name5] [data4][Address2][City2] [State2]
6)[Name6] [data5][Address2][City2] [State2]
7)[Name7] [data6][Address3][City3] [State3]

Thanks!!!



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!