VBA macro easy problem!

[Andrew Slentz]

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!

 

[Edwin Tam]

How about rewritting the macro? Try the following macro

'---------------------------------------------------
Sub FixData(
Dim c As Object, tmp As Singl
With Selection.CurrentRegio
If .Rows.Count > 1 The
For Each c In .Column
For tmp = 2 To .Rows.Coun
If c.Cells(tmp).Value = "" Then c.Cells(tmp).Value = c.Cells(tmp - 1).Valu
Nex
Nex
End I
.Columns(2).EntireColumn.Delet
End Wit
End Su
'---------------------------------------------------

Regards
Edwin Ta
(e-mail address removed)
http://www.vonixx.co


----- Andrew Slentz wrote: ----

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 som
reason I am losing the info. in the C column for the group members.
am also lost on how to get this to work if there are additional column
of information beyond F. Any ideas??

The code
Sub FixData(
Dim Rng1 As Range, Rng2 As Rang
Dim C As Range, DeleteRng As Rang
Dim FirstAdd As Strin

Application.ScreenUpdating = Fals

Set Rng1 = ActiveSheet.Columns("B"
Set C = Rng1.Find("Group", LookIn:=xlValues
If Not C Is Nothing The
FirstAdd = C.Addres
Set Rng2 = Range(C.Offset(, 1), C.Offset(, 5)
D
Set C = C.Offset(1
If LCase(Trim(C.Value)) = "group member" Then
Range(C.Offset(, 1), C.Offset(, 4)) = Rng2.Valu
Loop Until LCase(Trim(C.Value)) <> "group member
Set DeleteRng = Rng2.EntireRo
End I

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

Application.ScreenUpdating = Tru

End Su


Here is an example
A B C D E
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
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

 

[Greg Wilson]

See my response to your original post.

Regards,
Greg