R
robert.hatcher
II need help setting up a For Each statement to iterate through a
column and identity common values and then copy those rows to another
sheet. I really only need help with the for each part, I can noodle
my way through the copying and creating new sheets etc.
In the code I use <strg = "C"> to identify the value in the column to
look for, the code finds all the "C"s in the column, selects them,
and expands the selection to include the entire row.
What I need to to look at the column, and perform that task on all of
the prossible values, normaly A, B, C etc. In my terms it needs to
say:
For each letter in srchCol perform the code on all of each
possibility. Meaning all of the "A"s, "b"s or whatever...
the column is sorted in advance so that all like data are together
The working stuff looks like this:
Sub RowCopy()
Dim FirstAddress As String
Dim strg As String
Dim rng As Range
Dim rng2 As Range
Dim rng2Add As String
Dim srchCol As String
'Search the header row for the CONFIG column
Rows(1).Activate
'asign variable to CONFIG
srchCol = Selection.Find(what:="CONFIG", After:=ActiveCell,
LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Address
Range(srchCol).Select
'expand srchCol to include all data in column
srchCol = Range(srchCol, Selection.End(xlDown)).Address
'Set the value to search for in srchCol
'needs to be found in the CONFIG row and each occurance acted upon. A,
B etc.
strg = "C"
'with
With Sheets("Prepared").Range(srchCol)
Set rng = .Find(what:=strg, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "ron"
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
If rng2 Is Nothing Then
Set rng2 = rng
Else
Set rng2 = Application.Union(rng2, rng)
rng2Add = rng2.Address
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <>
FirstAddress
End If
End With
'Select all cells
If Not rng2 Is Nothing Then rng2.Select
Selection.EntireRow.Select
'run code to copy selected rows to a new sheet named the value of
strg
End Sub
Thnks
Robert
column and identity common values and then copy those rows to another
sheet. I really only need help with the for each part, I can noodle
my way through the copying and creating new sheets etc.
In the code I use <strg = "C"> to identify the value in the column to
look for, the code finds all the "C"s in the column, selects them,
and expands the selection to include the entire row.
What I need to to look at the column, and perform that task on all of
the prossible values, normaly A, B, C etc. In my terms it needs to
say:
For each letter in srchCol perform the code on all of each
possibility. Meaning all of the "A"s, "b"s or whatever...
the column is sorted in advance so that all like data are together
The working stuff looks like this:
Sub RowCopy()
Dim FirstAddress As String
Dim strg As String
Dim rng As Range
Dim rng2 As Range
Dim rng2Add As String
Dim srchCol As String
'Search the header row for the CONFIG column
Rows(1).Activate
'asign variable to CONFIG
srchCol = Selection.Find(what:="CONFIG", After:=ActiveCell,
LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Address
Range(srchCol).Select
'expand srchCol to include all data in column
srchCol = Range(srchCol, Selection.End(xlDown)).Address
'Set the value to search for in srchCol
'needs to be found in the CONFIG row and each occurance acted upon. A,
B etc.
strg = "C"
'with
With Sheets("Prepared").Range(srchCol)
Set rng = .Find(what:=strg, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "ron"
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
If rng2 Is Nothing Then
Set rng2 = rng
Else
Set rng2 = Application.Union(rng2, rng)
rng2Add = rng2.Address
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <>
FirstAddress
End If
End With
'Select all cells
If Not rng2 Is Nothing Then rng2.Select
Selection.EntireRow.Select
'run code to copy selected rows to a new sheet named the value of
strg
End Sub
Thnks
Robert