R
Robert H
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 doesn’t 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 doesn’t ïŒ
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
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 doesn’t 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 doesn’t ïŒ
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