The following code searches throgh a list of of like items until it finds a
different item, then it selects and
groups the like items. How can I add a loop to the code so it will find and
group all of the like items instead
of just the first occurance?

Thanks

Alex



Sub CopyData()

Dim LRow As Integer
Dim LColARange, LColARange0, LColARowUp, Row As String
Dim LContinue As Boolean

'Select Sheet1
Sheets("Sheet1").Select
Range("A2").Select

'Initialize variables
LContinue = True
LRow = 2

'Loop through all column A values until a blank cell is found or value
does not
' match cell A2's value
While LContinue = True

LRow = LRow + 1
LColARange = "A" & CStr(LRow)

'Found a blank cell, do not continue
If Len(Range(LColARange).Value) = 0 Then
LContinue = False
End If

'Found first occurrence that did not match cell A2's value, do not
continue
If Range("A2").Value <> Range(LColARange).Value Then
LContinue = False
End If

Wend

LColARange = "A" & CStr(LRow)
LColARange0 = "A" & CStr(LRow - 1) 'Lower Boundary
Row = CStr(LRow) & ":" & CStr(LRow)
lowerrow = CStr(LRow - 1)
upperrow = lowerrow - (lowerrow - 1) + 1
GrpRange = upperrow & ":" & lowerrow

Rows(Row).Select
Selection.Insert Shift:=xlDown
Range(LColARange0).Select
Selection.Copy
Range(LColARange).Select
ActiveSheet.Paste
Range(LColARange).Select
Selection.Font.Bold = True

Rows(GrpRange).Select
Selection.Rows.Group

Take a look at Find and FindNext in help, it should do what you want.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Alex" <(E-Mail Removed)> wrote in message
news:19C17069-6E5D-4AE6-9F42-(E-Mail Removed)...
> The following code searches throgh a list of of like items until it finds
a
> different item, then it selects and
> groups the like items. How can I add a loop to the code so it will find
and
> group all of the like items instead
> of just the first occurance?
>
> Thanks
>
> Alex
>
>
>
> Sub CopyData()
>
> Dim LRow As Integer
> Dim LColARange, LColARange0, LColARowUp, Row As String
> Dim LContinue As Boolean
>
> 'Select Sheet1
> Sheets("Sheet1").Select
> Range("A2").Select
>
> 'Initialize variables
> LContinue = True
> LRow = 2
>
> 'Loop through all column A values until a blank cell is found or value
> does not
> ' match cell A2's value
> While LContinue = True
>
> LRow = LRow + 1
> LColARange = "A" & CStr(LRow)
>
> 'Found a blank cell, do not continue
> If Len(Range(LColARange).Value) = 0 Then
> LContinue = False
> End If
>
> 'Found first occurrence that did not match cell A2's value, do not
> continue
> If Range("A2").Value <> Range(LColARange).Value Then
> LContinue = False
> End If
>
> Wend
>
> LColARange = "A" & CStr(LRow)
> LColARange0 = "A" & CStr(LRow - 1) 'Lower Boundary
> Row = CStr(LRow) & ":" & CStr(LRow)
> lowerrow = CStr(LRow - 1)
> upperrow = lowerrow - (lowerrow - 1) + 1
> GrpRange = upperrow & ":" & lowerrow
>
> Rows(Row).Select
> Selection.Insert Shift:=xlDown
> Range(LColARange0).Select
> Selection.Copy
> Range(LColARange).Select
> ActiveSheet.Paste
> Range(LColARange).Select
> Selection.Font.Bold = True
>
> Rows(GrpRange).Select
> Selection.Rows.Group