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

If strg = strRng Then
try using counter for rowoffset and column offset

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


"Robert H" wrote:

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

thanks Joel I've been experementing with that but have not had much
luck
should I be replacing

strRng.Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Set strRng = ActiveCell

with
x = 0
y = 0
Do Until strg < strRng
strRng.Offset(rowOffset:=y, columnOffset:=x).Activate
y = y + 1 (had to change this)

or using them in conjuction with each other?







On Feb 15, 11:25 am, Joel wrote:
If strg = strRng Then

try using counter for rowoffset and column offset

strRng.Activate
ActiveCell.Offset(rowOffset:=1,
columnOffset:=0).Activate
Set strRng = ActiveCell

X = 0
Y = 0 Do Until strg < strRng
strRngOffset(rowOffset:=Y,
columnOffset:=X).Activate

X = X + 1

Loop
End If
"Robert H" wrote:
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

here is an interesting twist that I found: If the data is sorted on
the column that the breakout is based on, in this case the "CODE"
column. the problem exists. like so:

CODE CONFIG TYPE DATE
Module 01 A RTN +11-11 2/8/2672
Module 01 B RTN +11-11 2/8/2672
Module 01 C +11-11 SHLD 2/8/2672
Module 02 A RTN +11-11 2/8/2672
Module 02 B RTN +11-11 2/8/2672
Module 02 C +11-11 SHLD 2/8/2672
Module 03 A RTN +11-11 2/8/2672
Module 03 B RTN +11-11 2/8/2672
Module 03 C +11-11 SHLD 2/8/2672

However, if the data is sorted on a different column as in this case
the "CONFIG" column, then the code works fine.
CODE CONFIG TYPE DATE
Module 01 A RTN +11-11 2/8/2672
Module 02 A RTN +11-11 2/8/2672
Module 03 A RTN +11-11 2/8/2672
Module 01 B RTN +11-11 2/8/2672
Module 02 B RTN +11-11 2/8/2672
Module 03 B RTN +11-11 2/8/2672
Module 01 C +11-11 SHLD 2/8/2672
Module 02 C +11-11 SHLD 2/8/2672
Module 03 C +11-11 SHLD 2/8/2672

Note, in these two examples the columns and rows have been cut down
considerably.

It works now, Im not realy sure what was wrong but I know that
improper declarations and sequencing had something to do with it. Here
is the final Code if your feeling brave :)

Sub BreakoutSheets()
Dim colHeadCol As Variant
Dim colHead As Variant
Dim srchCol As Variant
Dim strRngOld As Range
Dim strRng As Range
Dim x As Integer
Dim y As Integer
Dim rng As Range
Dim firstaddress As String
Dim rng2 As Range

'colHeadCol = Array("code") 'test set
colHeadCol = Array("CONFIG", "TYPE", "MO_Number", "CODE")
'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
Set srchCol = Range(srchCol, Selection.End(xlDown)) '.Address

'set strRngOld to something for the following test
Set strRngOld = Range("a1")

For Each strRng In srchCol

'Sets strRng to the the previous strRng
If Not strRngOld = "CODE" Then
Set strRng = strRngOld
End If

If strg = strRng Then
Do Until strg < strRng
strRng.Activate
ActiveCell.Offset(rowOffset:=1,
columnOffset:=0).Activate
Set strRng = ActiveCell
x = 0
y = 0
strRng.Offset(rowOffset:=y,
columnOffset:=x).Activate
y = y + 1
If strRng.Value = Empty Then
Exit Sub
End If
strRng.Select
Loop
End If

'Note location of current strRng
Set strRngOld = strRng

With 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 'Pastes new sheet and calls other setup
procedures
Next
SkipSheet:
Next
End Sub