PDA

View Full Version : Solved: Macro is off... need help with copy & paste function


agnesz
05-21-2009, 11:41 AM
I have this overview report which basically vlookups information from a lookup file. The macro
(thanks to VBA express gods) basically creates columns of data depending on how many tabs
exist in the lookup file. Three of these columns are % changes and this is where my problem lies.
My % change formulas keep referencing the same two columns no matter where on the
spreadsheet they fall!!!! Its so aggravating. Can someone please help????!!!!!:banghead:

Option Explicit
Sub Macro2()

Dim wsReport As Worksheet
Dim wbSource As Workbook
Dim Shts As Long
Dim ShName As String
Dim wbName As String
Dim i As Long
Dim Rws As Long
Set wsReport = Sheets("Store List")

MsgBox "Select LocSum Report to link to"

Application.Dialogs(xlDialogOpen).Show ActiveWorkbook.Path

Set wbSource = ActiveWorkbook
wbName = wbSource.Name
Shts = wbSource.Sheets.Count - 2

With wsReport
Rws = .Cells(Rows.Count, 1).End(xlUp).Row - 6
.Activate

For i = 3 To Shts
.Range("q2:v" & Rws).Copy .Cells(2, 17 + (6 * (i - 3)))
ShName = wbSource.Sheets(i).Name
.Cells(4, 19 + (6 * (i - 3))) = Split(ShName)(0)
.Cells(7, 17 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,'[" & wbName _
& "]" & ShName & "'!R14C7:R1500C55,7,FALSE)),0,(VLOOKUP(RC3,'[" & wbName & "]" & _
ShName & "'!R14C7:R1500C55,7,FALSE)))"
.Cells(7, 18 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,'[" & wbName & _
"]" & ShName & "'!R14C7:R1500C55,8,FALSE)),0,(VLOOKUP(RC3,'[" & wbName & "]" & ShName _
& "'!R14C7:R1500C55,8,FALSE)))"
.Cells(7, 19 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,'[" & wbName & "]" & _
ShName & "'!R14C7:R1500C55,9,FALSE)),0,(VLOOKUP(RC3,'[" & wbName & "]" & ShName & _
"'!R14C7:R1500C55,9,FALSE)))"



.Cells(7, 20 + (6 * (i - 3))).Formula = "=IF(ISERROR(q7/SUMIF($A$6:$A$765,""Grand Total"", _
q$6:q$765)),"" "",(q7/SUMIF($A$6:$A$765,""Grand Total"",q$6:q$765)))"
.Cells(7, 21 + (6 * (i - 3))).Formula = "=IF(ISERROR(q7/r7-1),"" "",(q7/r7-1))"
.Cells(7, 22 + (6 * (i - 3))).Formula = "=IF(ISERROR(q7/s7-1),"" "",(q7/s7-1))"

With .Cells(7, 17 + (6 * (i - 3))).Resize(Rws, 6)
.FillDown

End With
Next

End With

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

Sheets("Big Picture Subtotals").Activate

Set wsReport = Sheets("Big Picture Subtotals")

With wsReport
Rws = .Cells(Rows.Count, 1).End(xlUp).Row - 6
.Activate
'added -6 because 6 additional blank rows would pop up

For i = 3 To Shts
.Range("b4:g" & Rws).Copy .Cells(4, 2 + (6 * (i - 3)))
ShName = wbSource.Sheets(i).Name
.Cells(4, 4 + (6 * (i - 3))) = Split(ShName)(0)
.Cells(7, 2 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,'[" & wbName & "]" _
& ShName & "'!R900C9:R2000C18,5,FALSE)),0,(VLOOKUP(RC1,'[" & wbName & "]" & ShName _
& "'!R900C9:R2000C18,5,FALSE)))"
.Cells(7, 3 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,'[" & wbName & "]" _
& ShName & "'!R900C9:R2000C18,6,FALSE)),0,(VLOOKUP(RC1,'[" & wbName & "]" & ShName _
& "'!R900C9:R2000C18,6,FALSE)))"
.Cells(7, 4 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,'[" & wbName & "]" & _
ShName & "'!R900C9:R2000C18,7,FALSE)),0,(VLOOKUP(RC1,'[" & wbName & "]" & ShName & _
"'!R900C9:R2000C18,7,FALSE)))"



.Cells(7, 5 + (6 * (i - 3))).Formula = "=IF(ISERROR(B7/SUMIF($A$6:$A$757,""Total Selling _
Locations ONLY"",B$6:B$757)),"" "",(B7/SUMIF($A$6:$A$757,""Total Selling Locations ONLY"",B$6:B$757)))"
.Cells(7, 6 + (6 * (i - 3))).Formula = "=IF(ISERROR(b7/c7-1),"" "",(b7/c7-1))"
.Cells(7, 7 + (6 * (i - 3))).Formula = "=IF(ISERROR(b7/d7-1),"" "",(b7/d7-1))"

With .Cells(7, 2 + (6 * (i - 3))).Resize(Rws, 6)
.FillDown

End With
Next

End With

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

MsgBox "If you want the Store list subtotaled, please access the Excel Sorting/Subtotaling _
function to do so. Whatever subtotal you create on the intial setup will continue to populate _
going forward."
End Sub
MaximS
05-22-2009, 01:49 AM
hi agnesz,
i've found your error, now all you need to do is replace your code with below:


Option Explicit
Sub Macro2()

Dim wsReport As Worksheet
Dim wbSource As Workbook
Dim Shts As Long
Dim ShName As String
Dim wbName As String
Dim i As Long
Dim Rws As Long
Set wsReport = Sheets("Store List")
Dim x As Integer
Dim L, M, N As String

MsgBox "Select LocSum Report to link to"

Application.Dialogs(xlDialogOpen).Show ActiveWorkbook.Path

Set wbSource = ActiveWorkbook
wbName = wbSource.Name
Shts = wbSource.Sheets.Count - 2

With wsReport
Rws = .Cells(Rows.Count, 1).End(xlUp).Row - 6
.Activate

x = 17

For i = 3 To Shts

L = ColumnLetter(x)
M = ColumnLetter(x + 1)
N = ColumnLetter(x + 2)

.Range("q2:v" & Rws).Copy .Cells(2, 17 + (6 * (i - 3)))
ShName = wbSource.Sheets(i).Name
.Cells(4, 19 + (6 * (i - 3))) = Split(ShName)(0)
.Cells(7, 17 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,'[" & wbName _
& "]" & ShName & "'!R14C7:R1500C55,7,FALSE)),0,(VLOOKUP(RC3,'[" & wbName & "]" & _
ShName & "'!R14C7:R1500C55,7,FALSE)))"
.Cells(7, 18 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,'[" & wbName _
& "]" & ShName & "'!R14C7:R1500C55,8,FALSE)),0,(VLOOKUP(RC3,'[" & wbName & "]" _
ShName & "'!R14C7:R1500C55,8,FALSE)))"
.Cells(7, 19 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,'[" & wbName & _
"]" & ShName & "'!R14C7:R1500C55,9,FALSE)),0,(VLOOKUP(RC3,'[" & wbName & "]" & _
hName & "'!R14C7:R1500C55,9,FALSE)))"



.Cells(7, 20 + (6 * (i - 3))).Formula = "=IF(ISERROR(" & L & "7/SUMIF($A$6:$A$765, _
""Grand Total""," & L & "$6:" & L & "$765)),"" "",(" & L & "7/SUMIF($A$6:$A$765,""Grand _
Total""," & L & "$6:" & L & "$765)))"
.Cells(7, 21 + (6 * (i - 3))).Formula = "=IF(ISERROR(" & L & "7/" & M & "7-1),"" "",(" & L & "7/" _
& M & "7-1))"
.Cells(7, 22 + (6 * (i - 3))).Formula = "=IF(ISERROR(" & L & "7/" & N & "7-1),"" "",(" & L & "7/" _
& N & "7-1))"

With .Cells(7, 17 + (6 * (i - 3))).Resize(Rws, 6)
.FillDown

End With
Next

End With

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

Sheets("Big Picture Subtotals").Activate
Set wsReport = Sheets("Big Picture Subtotals")

With wsReport
Rws = .Cells(Rows.Count, 1).End(xlUp).Row - 6
.Activate
'added -6 because 6 additional blank rows would pop up

x = 2

For i = 3 To Shts

L = ColumnLetter(x)
M = ColumnLetter(x + 1)
N = ColumnLetter(x + 2)

.Range("b4:g" & Rws).Copy .Cells(4, 2 + (6 * (i - 3)))
ShName = wbSource.Sheets(i).Name
.Cells(4, 4 + (6 * (i - 3))) = Split(ShName)(0)
.Cells(7, 2 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,'[" & wbName & "]" _
& ShName & "'!R900C9:R2000C18,5,FALSE)),0,(VLOOKUP(RC1,'[" & wbName & "]" & ShName _
& "'!R900C9:R2000C18,5,FALSE)))"
.Cells(7, 3 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,'[" & wbName & "]" _
& ShName & "'!R900C9:R2000C18,6,FALSE)),0,(VLOOKUP(RC1,'[" & wbName & "]" & ShName _
& "'!R900C9:R2000C18,6,FALSE)))"
.Cells(7, 4 + (6 * (i - 3))).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,'[" & wbName & "]" & _
ShName & "'!R900C9:R2000C18,7,FALSE)),0,(VLOOKUP(RC1,'[" & wbName & "]" & ShName & _
"'!R900C9:R2000C18,7,FALSE)))"



.Cells(7, 5 + (6 * (i - 3))).Formula = "=IF(ISERROR(" & L & "7/SUMIF($A$6:$A$757, ""Total Selling _
Locations ONLY""," & L & "$6:" & L & "$757)),"" "",(" & L & "7/SUMIF($A$6:$A$757, ""Total Selling _
Locations ONLY""," & L & "$6:" & L & "$757)))"
.Cells(7, 6 + (6 * (i - 3))).Formula = "=IF(ISERROR(" & L & "7/" & M & "7-1),"" "",(" & L & "7/" & M & "7-1))"
.Cells(7, 7 + (6 * (i - 3))).Formula = "=IF(ISERROR(" & L & "7/" & N & "7-1),"" "",(" & L & "7/" & N & "7-1))"

With .Cells(7, 2 + (6 * (i - 3))).Resize(Rws, 6)
.FillDown

End With

x = x + 6

Next

End With

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

MsgBox "If you want the Store list subtotaled, please access the Excel Sorting/Subtotaling function to do so. _
Whatever subtotal you create on the intial setup will continue to populate going forward."
End Sub
Function ColumnLetter(ColumnNumber As Integer) As String
If ColumnNumber > 26 Then
ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function
agnesz
05-22-2009, 06:28 AM
maximS - thanks for that one... seems to be working on the "big picture" tab, but still not on the "store list" tab... weird.
Any thoughts?
Thanks so much again!
MaximS
05-22-2009, 07:10 AM
simple fix - in top part exchange that:


With .Cells(7, 17 + (6 * (i - 3))).Resize(Rws, 6)
.FillDown
End With
Next
End With


with:


With .Cells(7, 17 + (6 * (i - 3))).Resize(Rws, 6)
.FillDown
End With
x = x + 6
Next
End With
agnesz
05-29-2009, 01:07 PM
brilliance!
thanks a million