I have code that looks at column headings based on a predefined
array. For each column heading it looks at how many different items
€œstrRng€� are in that heading and breaks out (copies) of each
different type to a new sheet. For instance in the column there may be
2 module 1s, 5 module 2s and 3 module 3s. I end up with a sheet for
each data type or €œstrRng€�. The code calls other procedures to add
names, conditional formatting etc.

I have a step that tests to see if the worksheet exists prior to
creating it and if it does, skips to the next strRng.

If WorksheetExists(strg, ActiveWorkbook) Then
GoTo SkipSheet
Else

Buy itself that step worked great. But I had to add a step previous to
that to skip any strRng that had been previously counted.

If strg = strRng Then

Do Until strg < strRng
strRng.Activate
ActiveCell.Offset(rowOffset:=1,
columnOffset:=0).Activate
Set strRng = ActiveCell
strRng.Select
Loop
End If

This code works the first time it is used (during the second strRng)
but on the third set the program ends because the strRng jumps back to
an old position in the column causing €œIf strg = strRng Then€� to be
false so that code doesnt activate and advance down to the next set
and because a sheet by that name exists the program ends before
creating all the sheets.

Note, sometimes the data types may be in sequential order and
sometimes not.

I hope that that makes sense but I fear it doesnt �
The full code follows:

Sub BreakoutSheets()
Dim firstaddress As String
Dim rng As Range
Dim rng2 As Range
Dim srchCol 'As Range
Dim strRng As Range
Dim colHeadCol As Variant
Dim colHead As Variant

colHeadCol = Array("code") 'testing set to save time
'colHeadCol = Array("CODE", "CONFIG", "TYPE", "MO_Number")
'complete set

For Each colHead In colHeadCol

'select prepared worksheet
Worksheets("Prepared").Activate

'Search the header row for the column heading
Rows(1).Select
'assign variable to column heading
srchCol = Selection.find(What:=colHead, After:=ActiveCell,
LookIn:=xlValues, Lookat:= _
xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 0).Address

Range(srchCol).Select

'include used Column cells address in variable
srchCol = Range(srchCol, Selection.End(xlDown)).Address

Range(srchCol).Select

'PROBLEM STARTS HERE I think
For Each strRng In Selection

'Code to bypass items in the column that were
picked up in a _ previous set .
If strg = strRng Then

Do Until strg < strRng
strRng.Activate
ActiveCell.Offset(rowOffset:=1,
columnOffset:=0).Activate
Set strRng = ActiveCell
strRng.Select
Loop
End If

With Sheets("Prepared").Range(srchCol)

strg = strRng

If WorksheetExists(strg, ActiveWorkbook) Then
GoTo SkipSheet
Else

Set rng = .find(What:=strg, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
firstaddress = rng.Address
Set rng2 = rng

Do
If rng2 Is Nothing Then
Set rng2 = rng

Else
Set rng2 = Application.Union(rng2,
rng)
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And
rng.Address < firstaddress
End If
End If
End With

'Select all cells
If Not rng2 Is Nothing Then rng2.Select

Selection.EntireRow.Copy

PasteNewSheet
Next
SkipSheet:
Next
End Sub