Loop Through Sheets, Copy/Paste if Match

[ryguy7272]

I am trying to come up with a way of looping through all B2 cells in all
sheets and comparing the value to the values in a variable range, such as
B2:B15, on a specific sheet named “Regionâ€, and if there is a match, copy
paste the entire row (just one row) 2 lines below the match. Challenging?
Yes!! Possible? I don't know but I hope so!!



For next code below:

For Each sh In Worksheets
If LCase(sh.Name) <> LCase("Sheet1") Then
sh.Activate
With

‘Stuff…

End with

End If
Next sh
End Sub

Regards,
Ryan---

 

[JLGWhiz]

Hi Ryan, I did not test this so, it might hiccup, but the basic are there.

Sub chekB2()
Dim sh As Worksheet, c As Range
For Each sh In Worksheets
If LCase(sh.Name) <> LCase("Sheet1") Then
For Each c In Sheets("Region").Range("B2:B15")
If sh.Range("B2").Value = c.Value Then
MsgBox "Found"
Else
MsgBox "Not Found"
End If
Next
End If
Next
End Sub

 

[JLGWhiz]

After looking at it again, you probably want to exclude "Region" rather than
"Sheet1", although Region might be sheet 1. It will look for the tab name as
written and not the code name.

Sub chekB2()
Dim sh As Worksheet, c As Range
For Each sh In Worksheets
If LCase(sh.Name) <> LCase("Region") Then
For Each c In Sheets("Region").Range("B2:B15")
If sh.Range("B2").Value = c.Value Then
MsgBox "Found"
Else
MsgBox "Not Found"
End If
Next
End If
Next
End Sub

 

[JW]

Several different ways this could be done. Instead of looping through
the range in the Region sheet, I believe it would be more effeciant to
just use a CountIf function to see if it occurs in the range. You
didn't mention where you wanted the row 2 rows down to be copied to,
so this just sticks it in the first available row (based on Column A)
in Sheet1. Tweak as needed.
Sub ryguy7272()
Dim sh As Worksheet, rgnRange As Range, lRow As Long
Set rgnRange = Sheets("Region").Range("B2:B15")
For Each sh In Worksheets
With sh
If .Name <> "Region" And .Name <> "Sheet1" Then
If WorksheetFunction.CountIf(rgnRange, _
.Range("B2")) > 0 Then
.Range("B2").Offset(2, 0).EntireRow.Copy
Sheets("Sheet1").Range("A65536") _
.End(xlUp).Offset(1, 0).PasteSpecial
xlValues
End If
End If
End With
Next
Set rgnRange = Nothing
End Sub

 

[ryguy7272]

Oh My!!! Now I see the logic!! I was trying to do this complicated
Index/Match routine with an Offset...totalyl wrong approach. This is exactly
what I need. One more thing, how can I copy the range A1:O1 on "Region" and
dynamically offset paste to each sheet if the name is not "Region" or "Rep
Summary"?

Thanks so much!!
Ryan--

 

[JW]

Paste where in each sheet? This will copy A1:O1 of Region and place
it in the first available row in column A of every sheet not named
Region ot Rep Summary.
Sub ryguy7272_2()
Dim copyRange As Range, sh As Worksheet
Set copyRange = Sheets("Region").Range("A1:O1")
copyRange.Copy
For Each sh In Worksheets
With sh
If .Name <> "Region" And _
.Name <> "Rep Summary" Then _
.Range("A65536").End(xlUp) _
.Offset(1, 0).PasteSpecial xlValues
End With
Next sh
Application.CutCopyMode = False
Set copyRange = Nothing
End Sub

 

[ryguy7272]

Sub CpyPst()

Dim sh As Worksheet, rgnRange As Range, lRow As Long
Set rgnRange = Sheets("Region Summary").Range("B2:B15")
For Each sh In Worksheets
With sh
If .Name <> "Region Summary" And .Name <> "Rep Summary" Then
If WorksheetFunction.CountIf(rgnRange, _
..Range("B2")) > 0 Then
..Range("B2").Offset(1, 0).EntireRow.Copy

..Range("A65536") _
..End(xlUp).Offset(2, 0).PasteSpecial xlValues
End If
End If
End With
Next
Set rgnRange = Nothing

End Sub


I modified this macro and now it does some weird stuff. ïŒ It copies the
3rd row from each sheet, goes to the bottom, back up to the used range,
offsets 2, and pastes it there. What I wanted to do was look at values in
Column B in each sheet (not named Region Summary or Rep Summary) and find
matches in Column B in the region Summary sheet, and then, if there is a
match, paste/special, go to the bottom, back up to the used range, offsets 2,
and pastes it there. But even before this, I wanted to copy/paste the range
form A1:O1 on Region Summary to each sheet not named Region Summary or Rep
Summary. Finally, I wanted to bold this range that is copied to each sheet.
It is easy to do when the rows are fixed, but I’m not sure how to do it when
the rows are variable.

Sorry about this guys. The loops always get me! I look forward to the day
that I can get them!!

I'll take a few more cracks at it, and try to resolve it on my own, but if
you have time JW, I'd be grateful if you could get back to me with the answer.

Regards,
Ryan---

 

[ryguy7272]

Using the macro below:
Sub Ry()
Dim copyRange As Range, copyRange2 As Range, sh As Worksheet
Set copyRange = Sheets("Region Summary").Range("A1:O1")
Set copyRange2 = Sheets("Region Summary").Range("B2:B15")

copyRange.Copy
copyRange2.Copy

For Each sh In Worksheets
With sh

If .Name <> "Region Summary" And .Name <> "Rep Summary" Then
If WorksheetFunction.CountIf(copyRange2, _
..Range("B2")) > 0 Then
Sheets("Region Summary").Range("B2").Offset(2, 0).EntireRow.Copy
..Range("A65536") _
..End(xlUp).Offset(1, 0).PasteSpecial xlValues

If .Name <> "Region Summary" And _
..Name <> "Rep Summary" Then _
..Range("A65536").End(xlUp) _
..Offset(2, 0).PasteSpecial xlValues

End If
End If

End With
Next

Application.CutCopyMode = False
Set copyRange = Nothing


End Sub

Still encountering some weird behavior.

First, I wanted to copy/paste range A1:O1 from 'Region Summary' to each
sheet. then I wanted to bold this row (maybe fill the background as gray
too).

Second, I wanted to search through B2:B15 on 'Region Summary' and copy/paste
the matches to each respective sheet. The row three from 'Region Summary' is
always copied and pasted on each sheet. For instance, data for 'Frank' is
pasted into Frank's sheet, but also pasted to all other sheets.

Argh!! I guess with power comes complexity. VBA is powerful, and complex
too.
Any other thoughts JW?

Regards,
Ryan---


--
RyGuy

Sub CpyPst()

Dim sh As Worksheet, rgnRange As Range, lRow As Long
Set rgnRange = Sheets("Region Summary").Range("B2:B15")
For Each sh In Worksheets
With sh
If .Name <> "Region Summary" And .Name <> "Rep Summary" Then
If WorksheetFunction.CountIf(rgnRange, _
.Range("B2")) > 0 Then
.Range("B2").Offset(1, 0).EntireRow.Copy

.Range("A65536") _
.End(xlUp).Offset(2, 0).PasteSpecial xlValues
End If
End If
End With
Next
Set rgnRange = Nothing

End Sub


I modified this macro and now it does some weird stuff. ïŒ It copies the
3rd row from each sheet, goes to the bottom, back up to the used range,
offsets 2, and pastes it there. What I wanted to do was look at values in
Column B in each sheet (not named Region Summary or Rep Summary) and find
matches in Column B in the region Summary sheet, and then, if there is a
match, paste/special, go to the bottom, back up to the used range, offsets 2,
and pastes it there. But even before this, I wanted to copy/paste the range
form A1:O1 on Region Summary to each sheet not named Region Summary or Rep
Summary. Finally, I wanted to bold this range that is copied to each sheet.
It is easy to do when the rows are fixed, but I’m not sure how to do it when
the rows are variable.

Sorry about this guys. The loops always get me! I look forward to the day
that I can get them!!

I'll take a few more cracks at it, and try to resolve it on my own, but if
you have time JW, I'd be grateful if you could get back to me with the answer.

Regards,
Ryan---

 

[JW]

I wanted to copy/paste the range form A1:O1 on Region Summary to each sheet
not named Region Summary or Rep Summary. Next, I wanted to bold this range
that is copied to each sheet.

Finally, I wanted to do was look at values in Column B in 'Region Summary'
and compare these values with all sheets (not named Region Summary or Rep
Summary) in the workbook. Then, if there is a match, paste/special, go to
the bottom, back up to the used range, offsets 2, and paste it there.

Sub ryguy7272_2()
Dim copyRange As Range, copyRange2 As Range, sh As Worksheet
Dim rgnRange As Range, lRow As Long
Set copyRange = Sheets("Region Summary").Range("A1:O1")
Set copyRange2 = Sheets("Region Summary").Range("B2:B15")

copyRange.Copy
copyRange2.Copy

For Each sh In Worksheets
With sh
If .Name <> "Region Summary" And _
.Name <> "Rep Summary" Then _
.Range("A65536").End(xlUp) _
.Offset(2, 0).PasteSpecial xlValues
End With

If .Name <> "Region Summary" And .Name <> "Rep Summary" Then
If WorksheetFunction.CountIf(copyRange2, _
.Range("B2")) > 0 Then
.Range("B2").Offset(2, 0).EntireRow.Copy
Sheets("Region Summary").Range("A65536") _
.End(xlUp).Offset(1, 0).PasteSpecial xlValues
End If
Next

Application.CutCopyMode = False
Set copyRange = Nothing
End Sub

Without knowing the exact cause of the issue, I suspect it has to do with
the copyRange2 and the WorksheetFunction.

This function copies row three, from "Region Summary", and places it in each
Sheet, but I really just want items in the range B2:B15 on "Region Summary"
that match items in each sheet. For instance, if I find Frank in B2:B15, I
want to copy the entire row to the sheet with Frank's other data.

Sub CpyPst()

Dim sh As Worksheet, rgnRange As Range, lRow As Long
Set rgnRange = Sheets("Region Summary").Range("B2:B15")
For Each sh In Worksheets
With sh
If .Name <> "Region Summary" And .Name <> "Rep Summary" Then
If WorksheetFunction.CountIf(rgnRange, _
.Range("B2")) > 0 Then
Sheets("Region Summary").Range("B2").Offset(1, 0).EntireRow.Copy

.Range("A65536") _
.End(xlUp).Offset(2, 0).PasteSpecial xlValues
End If
End If
End With
Next
Set rgnRange = Nothing

End Sub

I'd really appreciate it if anyone could help me sort through the mess that
I made.

Regards,
Ryan---

--
RyGuy















- Show quoted text -

e-mail me your spreadsheet with detailed instructions on what you want
it to do.

 

[ryguy7272]

We took it off line for a bit; wanted to follow up here with the final outcome.
This is the final procedure that worked for me:


Sub giveThisAShot()
Dim sh As Worksheet
Dim srcRange As Range, c As Range
Dim lRow As Long
Dim searchValue As String
lRow = Sheets("Region Summary").Cells(Rows.Count, "B").End(xlUp).Row
Set srcRange = Sheets("Region Summary").Range("B2:B" & lRow)
For Each c In srcRange
searchValue = c.Value
c.EntireRow.Copy
For Each sh In Worksheets
With sh
If .Name = searchValue Then
.Range("A65536").End(xlUp).Offset(2, 0) _
.PasteSpecial xlPasteValues
End If
End With
Next sh
Next c
Application.CutCopyMode = False
Set srcRange = Nothing
End Sub


Big thanks to Jeff, and to others who looked at this!!

Regards,
Ryan--