For Each statement setup

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
 
N

nj

I'm not sure I fully understand but perhaps this example would get you
there:

I use it to search for key words in the cells in my previously set
selection. It is two loops, a "For... Each" to move thru the rows and
then a "For... Next" to work inside the cells themselves.

For Each Cell In Selection

'Loop to pick character in cell
For X = 1 To Len(Cell.Value)

'Loop to pick value to look FOR
'for y = 1 to
If Mid(Cell.Value, X, 1) = "Eri" Then
Cells(Cell.Row, 1).Value = Cells(Cell.Row, 1).Value & " eri"
End If
If Mid(Cell.Value, X, 1) = "test" Then
Cells(Cell.Row, 1).Value = Cells(Cell.Row, 1).Value & " test"
End If
If Mid(Cell.Value, X, 1) = "admin" Then
Cells(Cell.Row, 1).Value = Cells(Cell.Row, 1).Value & "
admin"
End If
'next y
Next X
Next Cell

Hope that helps!
NJ
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top