View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson[_4_] Greg Wilson[_4_] is offline
external usenet poster
 
Posts: 218
Default A Challenge! Can you handle it???

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)
.