Need to Improve Code Copying/Pasting Between Workbooks

I've created a new workbook using code from another workbook that copied one
datapoint to one page...for 17 pages or so (Each page had it's own
datapoint). The new workbook as all datapoints on one page. I need to copy
those datapoints from 30 sheets in one workbook to 30 sheets in the other
workbook. The source workbook is a weekly file that I am copying the weekly
totals from. The summary workbook has a column for each week ending date. I
test for the column dates to determine which column the data goes into. The
rows and pages are fixed. (In the prior code, it also tested for the row, the
pages were fixed).
I redid the code for the first page and it does exactly what I want, but I
now have to duplicate the code 29 more times and make the associated sheet
changes to obtain and write the data for all 30 sheets.

Is there any way to improve the current code that I've redone for sheet one
to have it do the same thing to the other 29 sheets?

Note: In the source workbook, I have a macro that lets the user set the
number of technicians, i.e., they can have a maximum of 30, but they may only
have 12. The number of technician sheets shown is then set to 12. Ideally, I
would like to have this macro read the number of technicians (which is
displayed on the "Global Settings" page, range ("F5") of the source workbook
and run the same code in this workbook to set the number of technician pages
to the same value and display only those pages (would always be 1 to x). And
then maybe the code would only go up to the amount of technician pages as
well.

Here is the code I have:

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

'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

'****Put this back when finished with code****
''Save the file
'With wbSum
'.Save
'End With

''Minimize Master BP Graph Workbook
'With wbSum
'WindowState = xlMinimized
'' Application.WindowState = xlNormal
'End With

''Save BP File to Franchise Directory
'With wbData
'Dim fname As String
'With ActiveWorkbook.Worksheets(2)
'fname = .Range("B4").Value & Format(.Range("F6").Value, " mm dd yyyy") &
".xls"

'****End of Put this back****

'****For Network Drive Path - Put Back!!*****
'ChDrive "F:"
'ChDir "F:\Franchise_GPC\Ben Franklin Info\Ben Franchises\2006 Big Picture\"
'.SaveAs "F:\Franchise_GPC\Ben Franklin Info\Ben Franchises\2006 Big
Picture\" & fname

'****Put this back for local testing when finished with coding****
''****FileName for Testing Only - Take Out and Put Back Above for Work*****
'.SaveAs fname

'End With

'With wbData
'ActiveWorkbook.Close

'End With

''Minimize Master BP Graph Workbook Again
'With wbSum
'Application.WindowState = xlMinimized
'End With
'****End of Put this back****
End With

End Sub

Send your code and workbook and all info to:


"David" wrote:

I've created a new workbook using code from another workbook that copied one
datapoint to one page...for 17 pages or so (Each page had it's own
datapoint). The new workbook as all datapoints on one page. I need to copy
those datapoints from 30 sheets in one workbook to 30 sheets in the other
workbook. The source workbook is a weekly file that I am copying the weekly
totals from. The summary workbook has a column for each week ending date. I
test for the column dates to determine which column the data goes into. The
rows and pages are fixed. (In the prior code, it also tested for the row, the
pages were fixed).
I redid the code for the first page and it does exactly what I want, but I
now have to duplicate the code 29 more times and make the associated sheet
changes to obtain and write the data for all 30 sheets.

Is there any way to improve the current code that I've redone for sheet one
to have it do the same thing to the other 29 sheets?

Note: In the source workbook, I have a macro that lets the user set the
number of technicians, i.e., they can have a maximum of 30, but they may only
have 12. The number of technician sheets shown is then set to 12. Ideally, I
would like to have this macro read the number of technicians (which is
displayed on the "Global Settings" page, range ("F5") of the source workbook
and run the same code in this workbook to set the number of technician pages
to the same value and display only those pages (would always be 1 to x). And
then maybe the code would only go up to the amount of technician pages as
well.

Here is the code I have:

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

'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