Need to loop my macro

D

David

I have a macro to copy specific cells on 30 worksheets and paste that data to
another workbook to specific cells on 30 worksheets. The target workbook has
a column for the date of the source workbook. I'm getting a Project too large
error and think a loop procedure would fix the problem. I know there must be
a much simplier solution but I have no experience with looping. Here is the
code for the first 2 pages...it simply repeats until the 30th page.

Sub CapturePlumberData()
Dim wbSum As Workbook, wbData As Workbook
Set wbSum = Workbooks("2006 Consolidated Plumber File.xls")
Set wbData = ActiveWorkbook

' get source data from open sheet
Dim iOffice As Integer, iDate As Date, iValue '==IOffice is not needed==

'First Sheet - Need to do this for all 30 sheets
With wbData.Sheets(4)
'Don't need the ioffice Range
iOffice = .Range("J6")
iDate = .Range("C11")
With wbData.Sheets(4)
iValueSG = .Range("J15")
iValueAS = .Range("J16")
iValueV = .Range("J17")
iValueCR = .Range("J18")
iValueCC = .Range("J19")
iValueCRate = .Range("J20")
iValueAVGS = .Range("J21")
iValueRHW = .Range("J22")
iValueOHW = .Range("J23")
iValueLWP = .Range("J24")
iValueWPPS = .Range("J25")
ivalueRV = .Range("J26")
iValueBFSS = .Range("J27")
iValueBMV = .Range("J28")
iValueBIO = .Range("J29")
iValueRW = .Range("H33")
iValueOW = .Range("H34")
iValueBN = .Range("J31")
iValueSP = .Range("J32")
iValueTB = .Range("J33")
iValueTH = .Range("J34")
iValueTAW = .Range("J35")
iValueTWPPS = .Range("J36")

End With

' Set Px Sheets and apply all values

' apply iValueSG - Sales Goal to matched row and column
With wbSum.Sheets(2)
Dim lastrow As Long, lastcol As Long, xV As Long, xR As Long, xC As Long
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 2
' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueSG
End With

' apply iValueAS - Actual Sales to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 3

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueAS
End With

' apply iValueV - Sales Variance to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column

''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 4

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueV
End With

' apply iValueCR - Calls Run to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 5

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueCR
End With

' apply iValueCC - Calls Closed to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 6

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueCC
End With

' apply iValueCRate - Calls Closed Rate to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 7

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueCRate
End With

' apply iValueAVGS - Average Sale to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 8

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueAVGS
End With

' apply iValueRHW - Regular Hours Worked to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 9

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueRHW
End With

' apply iValueOHW - OverTime Hours Worked to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 10

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueOHW
End With

' apply iValueLWP - Labor Wages Paid to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 11

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueLWP
End With

' apply iValueWPPS - Wages Paid as Percent of Sales to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 12

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueWPPS
End With

' apply iValueRV - Return Visits to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 13

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = ivalueRV
End With

' apply iValueBFSS - Ben Franklin Society's Sold to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 14

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueBFSS
End With

' apply iValueBMV - BFS Maintenance Visits to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 15

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueBMV
End With

' apply iValueBIO - Bio Smarts Sold to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 16

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueBIO
End With


' apply iValueRW - Regular Wages to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 17

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueRW
End With

' apply iValueOW - OverTime Hours to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 18

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueOW
End With

' apply iValueBN - Bonuses to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 19
' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueBN
End With

' apply iValueSP - Spiffs to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 20

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueSP
End With

' apply iValueTB - Total Bonuses to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 21

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueTB
End With

' apply iValueTH - Total Hours to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 22

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueTH
End With

' apply iValueTAW - Total All Wages to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 23

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueTAW
End With

' apply iValueTWPPS - Total Wages Paid Percent of Sales to matched row and
column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 24

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueTWPPS
End With

' END OF FIRST SHEET - NEED TO IMPROVE CODE ABOVE - REPEAT 29 TIMES :(

'Second Sheet - Need to do this for all 30 sheets
With wbData.Sheets(5)
'Don't need the ioffice Range
iOffice = .Range("J6")
iDate = .Range("C11")
With wbData.Sheets(5)
iValueSG = .Range("J15")
iValueAS = .Range("J16")
iValueV = .Range("J17")
iValueCR = .Range("J18")
iValueCC = .Range("J19")
iValueCRate = .Range("J20")
iValueAVGS = .Range("J21")
iValueRHW = .Range("J22")
iValueOHW = .Range("J23")
iValueLWP = .Range("J24")
iValueWPPS = .Range("J25")
ivalueRV = .Range("J26")
iValueBFSS = .Range("J27")
iValueBMV = .Range("J28")
iValueBIO = .Range("J29")
iValueRW = .Range("H33")
iValueOW = .Range("H34")
iValueBN = .Range("J31")
iValueSP = .Range("J32")
iValueTB = .Range("J33")
iValueTH = .Range("J34")
iValueTAW = .Range("J35")
iValueTWPPS = .Range("J36")

End With

' Set Px Sheets and apply all values

' apply iValueSG - Sales Goal to matched row and column
With wbSum.Sheets(3)

lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 2
' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueSG
End With

' apply iValueAS - Actual Sales to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 3

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueAS
End With

' apply iValueV - Sales Variance to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column

''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 4

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueV
End With

' apply iValueCR - Calls Run to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 5

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueCR
End With

' apply iValueCC - Calls Closed to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 6

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueCC
End With

' apply iValueCRate - Calls Closed Rate to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 7

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueCRate
End With

' apply iValueAVGS - Average Sale to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 8

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueAVGS
End With

' apply iValueRHW - Regular Hours Worked to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 9

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueRHW
End With

' apply iValueOHW - OverTime Hours Worked to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 10

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueOHW
End With

' apply iValueLWP - Labor Wages Paid to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 11

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueLWP
End With

' apply iValueWPPS - Wages Paid as Percent of Sales to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 12

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueWPPS
End With

' apply iValueRV - Return Visits to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 13

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = ivalueRV
End With

' apply iValueBFSS - Ben Franklin Society's Sold to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 14

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueBFSS
End With

' apply iValueBMV - BFS Maintenance Visits to matched row and column
With wbSum.Sheets(3)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 15

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR > 0 And xC > 0 Then .Cells(xR, xC) = iValueBMV
End With

etc, etc
 
D

davidm

David,

Since both your data source (copy) ranges and destination (paste
ranges are not systematic ie do not conform to a discernible pattern
you cannot apply looping to any effect. I would suggest that yo
restructure your data such that the source data maps into th
destination ranges in a certain kind of fashion (but this may no
always be possible)
 
D

Don Guillett

I have no experience with looping.
But your macro is full of looping

for i=
code
next

is a loop so

for i=1 to 30
With wbData.Sheets(i)
next i

No need to copy each in contigous range
Range("k1:k5").Value = Range("j14:j18").Value

''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"
Click to expand...
Why not just use FIND instead of the loop here? Something like
if cells.find(.cells(xv,1) then
xr=xv
else
xr=3
end if

etc,
Merry Xmas
 
D

David

Hi David,
I think they are systematic, to the extent that the range copied on each
sheet is the same, and the range copied to is always the same row, just a
different data (column). The source workbooks are weekly files, where I am
copying the total values off each worksheet and pasting them to a
consolidated worksheet where each of the 30 pages is the totals for the same
30 pages in the source workbook, except the workbook I'm pasting into has a
date column that must be matched to the date in the source workbook. Does
that help?
 
D

David

That's a start in the right direction! Thanks for taking your time on the
Christmas Day!!
 

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

iValue Stops after 10 cells of data 1
Copy/Paste to Specific Row with matching Value 0
Need to Improve Code Copying/Pasting Between Workbooks 1
Find Cell in Named Range 3
Validate MsgBox Entry to Data in Cells 13
RT Error 438 7
How to make loop code more efficient 4
Running macro 1

Top