A Challenge! Can you handle it???

[Andrew Slentz]

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!

 

[Greg Wilson]

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)

 

[Greg Wilson]

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

 

[Andrew Slentz]

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!

 

[Greg Wilson]

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
: