EASY - Excel VBA Problem

[Andrew Slentz]

I have a macro (below) which performs the functions shown in the sample
spreadsheet (below). It works fine except that if instead of having
line 7 be another name you have line 7 be another "group" (ie. a group
immediately following a previous group) it doesn't work properly and
ignores the next group. This means to work there must be a row without
"group" or "group member" in it before the next "group" can work. How
do I handle one group (with members) immediately followed by another
group (with members)??? There can be a number of groups in a row before
a row without a group.

Any help would be really appreciated.

Thanks,

Andrew


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" [Address3][City3] [State3]
3)[Name6] "Group member" [data4]
4)[Name7] "Group member" [data5]
7)[Name8] [data6][Address4][City4] [State4]

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)[Name6] [data4][Address3][City3] [State3]
6)[Name7] [data5][Address3][City3] [State3]
7)[Name8] [data6][Address4][City4] [State4]

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

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

 

[Nigel]

Is this yet another copy of the same post ?

 

[Andrew Slentz]

Yep, except I am running into one specific issue and wanted to see if I
could get some help with that...

Thanks,

Andrew


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

 

[Andrew Slentz]

Yep, except I am running into one specific issue and wanted to see if I
could get some help with that...

Thanks,

Andrew


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

 

[Andrew Slentz]

Yep, except I am running into one specific issue and wanted to see if I
could get some help with that...

Thanks,

Andrew


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

 

[Nigel]

Its doubtful if you send multiple posts !!

 

[Greg Wilson]

Assuming there arn't any gaps in the data then perhaps this
simplification:

Sub Group()
Dim C As Range, NumRows As Integer
Dim Rng1 As Range, Rng2 As Range
NumRows = Range("A65536").End(xlUp).Row
Set Rng1 = Range("D2:I" & NumRows)
Set Rng2 = Range("B2:B" & NumRows)
For Each C In Rng1
If LCase(Trim(Cells(C.Row, 2))) = "group member" Then
C.Value = C.Offset(-1).Value
End If
Next
For Each C In Rng2
If LCase(Trim(C.Value)) = "group" Then
C.EntireRow.Delete
End If
Next
Columns(2).EntireColumn.Delete
End Sub

Regards,
Greg


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