Searching cell values...

O

Outatym

I am needing to search column G on the "Master" sheet for certain states
starting at row 3. If if finds the correct state, say AR, then I need it to
copy that entire row and paste it into another worksheet. Here is the code I
am working with:

***********************************************************
Sheets("Master").Activate

For i = 3 To Cells(Rows.Count, 7).End(xlUp).Row
If Cells(i, 7).Text = "AR" Then
Selection.EntireRow.Copy
Worksheets("Ed").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "TN" Then
Selection.EntireRow.Copy
Worksheets("Beverly").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "IL" Then
Selection.EntireRow.Copy
Worksheets("Kevin").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "GA" Then
Selection.EntireRow.Copy
Worksheets("Chris E").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "SC" Then
Selection.EntireRow.Copy
Worksheets("Chris E").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "IN" Then
Selection.EntireRow.Copy
Worksheets("David F").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "OH" Then
Selection.EntireRow.Copy
Worksheets("David F").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "PA" Then
Selection.EntireRow.Copy
Worksheets("David F").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "MI" Then
Selection.EntireRow.Copy
Worksheets("Louise").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "MO" Then
Selection.EntireRow.Copy
Worksheets("Louise").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "VA" Then
Selection.EntireRow.Copy
Worksheets("Louise").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "AL" Then
Selection.EntireRow.Copy
Worksheets("Bunny").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "MS" Then
Selection.EntireRow.Copy
Worksheets("Bunny").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

If Cells(i, 7).Text = "FL" Then
Selection.EntireRow.Copy
Worksheets("Bunny").Activate
Rows("3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False
End If

Next

***********************************************************

But for some reason it will only find CA and paste mutiple copies of that
row. I've apparently gotten something screwed up here....
 
J

JW

Gove something like this a shot. There isn't a need to make all of
those activations and selctions.
To add more states to this, simply add a new Case statement before the
Case Else statement and follow the same conventions as the others.
Sub tester()
Dim shName As String
With Sheets("Master")
For i = 3 To .Cells(.Rows.Count, 7).End(xlUp).Row
With .Cells(i, 7)
Select Case .Text
Case "AR"
shName = "Ed"
Case "TN"
shName = "Beverly"
Case "IL"
shName = "Kevin"
Case "GA"
shName = "Chris E"
Case "SC"
shName = "Chris E"
Case "IN"
shName = "David F"
Case "OH"
shName = "David F"
Case "PA"
shName = "David F"
Case "MI"
shName = "Louise"
Case "MO"
shName = "Louise"
Case "VA"
shName = "Louise"
Case "AL"
shName = "Bunny"
Case "MS"
shName = "Bunny"
Case "FL"
shName = "Bunny"
Case Else
shName = "NotFound"
End Select
If shName <> "NotFound" Then
Worksheets(shName).Rows(3) _
.Insert Shift:=xlDown
.EntireRow.Copy _
Worksheets(shName).Cells(3, 1)
End If
End With
Next
End With
End Sub
 
J

JW

Actually, now that I think about it, you can combine several of those
Case statements. Try this.
Sub tester()
Dim shName As String
With Sheets("Master")
For i = 3 To .Cells(.Rows.Count, 7).End(xlUp).Row
With .Cells(i, 7)
Select Case .Text
Case "AR"
shName = "Ed"
Case "TN"
shName = "Beverly"
Case "IL"
shName = "Kevin"
Case "GA", "SC"
shName = "Chris E"
Case "IN", "OH", "PA"
shName = "David F"
Case "MI", "MO", "VA"
shName = "Louise"
Case "AL", "MS", "Fl"
shName = "Bunny"
Case Else
shName = "NotFound"
End Select
If shName <> "NotFound" Then
Worksheets(shName).Rows(3) _
.Insert Shift:=xlDown
.EntireRow.Copy _
Worksheets(shName).Cells(3, 1)
End If
End With
Next
End With
End Sub
 
J

JW

Typo in post above. Sorry about that.
Sub tester()
Dim shName As String
With Sheets("Master")
For i = 3 To .Cells(.Rows.Count, 7).End(xlUp).Row
With .Cells(i, 7)
Select Case .Text
Case "AR"
shName = "Ed"
Case "TN"
shName = "Beverly"
Case "IL"
shName = "Kevin"
Case "GA", "SC"
shName = "Chris E"
Case "IN", "OH", "PA"
shName = "David F"
Case "MI", "MO", "VA"
shName = "Louise"
Case "AL", "MS", "FL"
shName = "Bunny"
Case Else
shName = "NotFound"
End Select
If shName <> "NotFound" Then
Worksheets(shName).Rows(3) _
.Insert Shift:=xlDown
.EntireRow.Copy _
Worksheets(shName).Cells(3, 1)
End If
End With
Next
End With
End Sub
 
O

OssieMac

There are better methods of achieving what you are doing but I'll point out
the problems that I can see with your code.

Selection.EntireRow.Copy
Above line will be the row where the active or selected cell is; not related
to
Cells(i, 7). You need to select cells(i,7) first or the following also works:-

Cells(i, 7).EntireRow.Copy

You need to re-activate Master after activating other sheets and before the
next copy. Do this just before Next i.

Sheets("Master").Activate
Next i

I have not tested your code so get back to me if still having problems.

Regards,

OssieMac
 
O

Outatym

It actually works! But for some reason it isn't picking up AR and putting it
in the "Ed" worksheet...any ideas why?
 
J

JW

Nope. It should be picking it up fine. Make sure that you cell
containing AR doesn't contain an extra space or something out of the
ordinary like that. If you still have problems, feel free to send me
the file to the e-mail in my profile and I'll take a look at it.
 

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

Similar Threads

Help again!!! 1
Tannspose and cycle 4
Simplify Code for Copy/Paste Special 10
Filename Problem In a Macro 4
Macro Related to Paste Values 2
Copying Solver results of each iteration to a given location in a workbook 1
Help merging two VBA codes 2
Variable not defined for "number of trials" ? 3

Top