This one really has me stumped. I have a spreadsheet (see below) which
contains (at random times) a group with members in it. The beginning of
the group, and all mailing address/contact info., is identified with a
leading row which has "Group" in column B. All subsequent members of
that particular group will have "Group Member" in the B column and will
not have an address or any contact info. I need to get one macro which
will take the contact info. (column c,d,e,f) and copy it to all group
members. I then need another to delete all rows with "group" in the B
column and finally the B colum in its entirety. Any ideas??? I also need
to know how to change the column designations in case the layout
changes. Remember, there are multiple groups in a spreadsheet but each
member of a group immediately follows the group heading! In the scenario
below the address, city, state (and colum g&h) would be copied from row
2 to rows 3,4,5,6. Rows 1 and 7 never get touched. Another macro then
deletes all rows like Row 2 and then deletes the B column.

Anyone who figures this out will definitely be my hero!

Thanks in advance!!!

ORIGINAL:
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 F
1)[Name1] [data1][Address1][City1] [State1]
2)[Name2] "Group" [Address2][City2] [State2]
3)[Name3] "Group member" [data2][Address2][City2] [State2]
4)[Name4] "Group member" [data3][Address2][City2] [State2]
5)[Name5] "Group member" [data4][Address2][City2] [State2]
6)[Name6] "Group member" [data5][Address2][City2] [State2]
7)[Name7] [data6][Address3][City3] [State3]

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

The following macro is in accordance with my read of your
post and has not been rigorously tested. Hope it's what
you were after:-

Sub FixData()
Dim Rng1 As Range, Rng2 As Range
Dim C As Range, CC As Range, DeleteRng As Range
Dim FirstAdd As String, txt1 As String, txt2 As String

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(, 4))
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(, 4))
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
End Sub

Regards,
Greg
(VBA amateur)

You can delete the declared variables CC, txt1 and txt2.
I forgot to remove them. Also, if there is a lot of data,
you may want to use "Application.ScreenUpdating = False"
immediately after the variable declarations and then
repeat this line except make it True just before the End
Sub.

Regards,
Greg

-----Original Message-----
The following macro is in accordance with my read of your
post and has not been rigorously tested. Hope it's what
you were after:-

Sub FixData()
Dim Rng1 As Range, Rng2 As Range
Dim C As Range, CC As Range, DeleteRng As Range
Dim FirstAdd As String, txt1 As String, txt2 As String

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(, 4))
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(, 4))
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
End Sub

Regards,
Greg
(VBA amateur)
.

Thanks for that!!! Nice stuff! I was doing some testing though and
noticed two things... Any ideas???

Based on the example I provided when a group's address is copied to the
member's record the data in column C for the member is lost. Any ideas?
Also the information on the group is carried over but there is more
information in columns G,H and sometimes J. What do I do to make sure
that's copied to the group members also???

Thanks,

Andrew


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

Perhaps this:

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(, 2), C.Offset(, 7))
Do
Set C = C.Offset(1)
If LCase(Trim(C.Value)) = "group member" Then _
Range(C.Offset(, 2), C.Offset(, 7)) = 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(, 2), C.Offset(, 7))
Do
Set C = C.Offset(1)
If LCase(Trim(C.Value)) = "group member" Then _
Range(C.Offset(, 2), C.Offset(, 7)) = 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

Note that the code is designed to be case insensitive and to ignor
leading and/or trailing spaces in case of sloppy typing.

Regards,
Greg
:

--
Message posted from http://www.ExcelForum.com