LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,560
Default Need to loop my macro

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
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro Loop stan Excel Discussion (Misc queries) 1 October 22nd 09 04:38 PM
Loop Macro? Carmen Excel Programming 3 May 10th 05 01:00 PM
Loop a macro Steve[_71_] Excel Programming 3 February 9th 05 04:15 PM
Loop macro help. Pete[_13_] Excel Programming 4 November 15th 03 01:22 AM
Loop macro help. Pete[_13_] Excel Programming 2 November 14th 03 10:32 PM


All times are GMT +1. The time now is 07:16 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"