Stringing a bunch of Subs together creates an error But running separately does not

[sschwant]

I am completely baffled by this and can not seem to isolate the issue in debugging mode using "run to cursor" Ctrl F8.

If I run the whole sequence from start to finish, it breaks down mid way at the point where it begins to copy AP data onto my Actuals Consol tab, and then copy in & append my JE Table to my Acutals Consol tab. Next step here is to insert a column (E), shifting over 1, and rename new Col E as "FCST". Then I copy all this data to an Actuals & FCST Consol tab, and then copy / append to that tab again with my FC Details. This tab b/comes the source data for my pivot. Some how if I string it all together - - I get 1) an extra FC col in the Actuals Consol tab, and 2) the FC total is over stated (extra rows get inserted as well I guess ... maybe some kind of lopping issue?).

Any way ... at best ... someone might be able to easily isolate my error here which would be great. At worst I set this up as a two stage process instead of one. B/c if I insert multiple breaks before the Actuals Consol steps and then run those macros manually one by one, or even just let them run on from there w/ a single break at that key point ... it works just fine!

Cross posted here w/ a link to my zipped file on OneDrive: http://answers.microsoft.com/en-us/office/forum/office_2010-excel/how-to-redirect-a-macro-if-an-auto-filter-criteria/3cd539e6-de80-4646-9d76-7a6aa9acd136.

Here's the direct link to oneDrive: https://1drv.ms/u/s!Agy4YBOwP78vgnjFnThVwIwgldQl
It's the "Month End" file ...

Here's the VBA for the whole 'build pivot process':



ub Stage_AP_data_step_1()
'
' AP_data Macro
' After running Qry_Mrg in NCT database, copy paste values into the "AP Qry Dataset" tab onto cell A1.
' This section rearranges the columns prior to merging AP & JE data on "Actuals Consol" tab.


Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("AP Qry Dataset").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Font.Size = 10
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = False
ActiveWindow.FreezePanes = True
Cells.Select
Cells.EntireColumn.AutoFit
Columns("E:E").Select
Selection.Cut
Range("R1").Select
ActiveSheet.Paste
Range("S1").Select
ActiveCell.FormulaR1C1 = "Div"
Columns("N:O").Select
Selection.Cut
Range("T1").Select
Selection.Insert Shift:=xlToRight
Range("O1:S1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Call Stage_JE_raw_Data_Step2
End Sub
''' following macros inserted from Staging JE Data only_v4.xlsm dev workbook:


Sub Stage_JE_raw_Data_Step2()
'
Application.ScreenUpdating = False
Sheets("Stage raw JE data").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Rows("1:1").Select
Selection.RowHeight = 24.75
Rows("1:1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.Zoom = 90
' Stage_JE_raw_data Macro - part 2
' Rearrange columns on worksheet after copying and pasting values onto blank sheet "Stage raw JE data"


' Sheets("Stage raw JE data").Select
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "GroupID"
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G1").Select
ActiveCell.FormulaR1C1 = "Division"
Range("P1").Select
ActiveCell.FormulaR1C1 = "VendorName"
Columns("P:Q").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Select
Cells.EntireColumn.AutoFit
Range("A2").Select
Call SORT_JE
End Sub


Sub SORT_JE()
'
' SORT_JE Macro

Application.ScreenUpdating = False
Sheets("Stage raw JE data").Select
Columns("A:R").Select
ActiveWorkbook.Worksheets("Stage raw JE data").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Stage raw JE data").Sort.SortFields.Add Key:=Range _
("Q2:Q4623"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Stage raw JE data").Sort
.SetRange Range("A1:R4623")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call Move_AP_Out
End Sub


Sub Move_AP_Out()
'
Application.ScreenUpdating = False
Sheets("Stage raw JE data").Select
Range("Q1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$R$4622").AutoFilter Field:=17, Criteria1:= _
"AP Accruals"
ActiveCell.Offset(1, -16).Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy

' Switch to AP Accls tab
Sheets("AP Accls").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


' Switch back to Stage raw data tab


Sheets("Stage raw JE data").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
ActiveSheet.AutoFilterMode = False
Range("A2").Select
Call Move_Xfers_Out
End Sub


Sub Move_Xfers_Out()

Application.ScreenUpdating = False
Sheets("Stage raw JE data").Select

'' Ensure AutoFilter off before AutoFilter line

ActiveSheet.AutoFilterMode = False
Range("Q1").Select

'' Next line toggles AutoFilter On and Off so ensure Off before this line_
'' (as per previous comment)

Selection.AutoFilter


' ActiveSheet.Range("$A$1:$R$4062").AutoFilter Field:=17, Criteria1:= _
"=*Xfers*", Operator:=xlAnd

'' Next line "AutoFilter.Range" is generic and don't need to know exact range

ActiveSheet.AutoFilter.Range.AutoFilter Field:=17, Criteria1:= _
"=*Xfers*", Operator:=xlAnd

With ActiveSheet.AutoFilter.Range
If .Columns(17).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

ActiveCell.Offset(1, -16).Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy

' Switch to IC Transfers tab and copy paste range selection

Sheets("IC Transfers").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Switch back to JE raw data tab

Sheets("Stage raw JE data").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
' Selection.AutoFilter = False
ActiveSheet.AutoFilterMode = False

'' If month w/ Xfers macro appends last 3 cols at this point (or it has in past iterations)
Else: Call Copy_Stgd_JE_data_to_TblJE
End If
End With
Call Copy_Stgd_JE_data_to_TblJE
End Sub


Sub Copy_Stgd_JE_data_to_TblJE()
'
Application.ScreenUpdating = False
Sheets("Stage raw JE data").Select
ActiveSheet.AutoFilterMode = False
Range("A2:R2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

' Switch sheets
Sheets("tblJE").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call tblJE_Fill_down

End Sub

Sub tblJE_Fill_down()


' Copy formulas down
Dim lR As Long
lR = Range("A:R").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("S2:AH" & lR).FillDown


Call Insert_Group_ID_in_tblJE


End Sub


Sub Insert_Group_ID_in_tblJE()


Range("E2").Select
ActiveCell.FormulaR1C1 = "=RC[29]"
Range("E2").Select
Dim LastRow As Long
LastRow = Range("D:E").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("E2:E" & LastRow).FillDown


Call Copy_AP_Data_Onto_Actuals_Consol_tab


End Sub




Sub Copy_AP_Data_Onto_Actuals_Consol_tab()


' Copies staged AP Qry data, then calls new_Copy_JE macro to copy from TblJE


Application.ScreenUpdating = False
Sheets("AP Qry Dataset").Select
Range("O2:S2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Actuals Consol").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Call new_copy_tbl_JE

End Sub
Sub new_copy_tbl_JE()


Application.ScreenUpdating = False
Sheets("tblJE").Select
Range("E2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

'' Switch to Actuals Consol tab - - copy and append TblJE to APQry dataset at bottom row


Sheets("Actuals Consol").Select
'' insert newly tested code
Dim LastRow As Long
LastRow = Range("A:E").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A" & LastRow).Select
Selection.Offset(1, 0).Range("A1").Select



'' Range("A2").Select
'' Range(Selection, Selection.End(xlDown)).Select
'' Range("A3").Select
'' Selection.End(xlDown).Select
'' ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call Insert_1_Col_for_FCST
End Sub


Sub Insert_1_Col_for_FCST()


Sheets("Actuals Consol").Select
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "FCST"
' Range("A1").Select


Call Copy_Actuals_Consol_to_Actuals_FC_Consol
End Sub




Sub Copy_Actuals_Consol_to_Actuals_FC_Consol()
'
' Copy_Actuals_Consol_to_Actuals_FC_Consol Macro
'


Application.ScreenUpdating = False
Sheets("Actuals Consol").Select
Range("A2:F2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Actuals and FC Consol").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call Copy_FC_Details_to_Actuals_FC_Consol


End Sub




Sub Copy_FC_Details_to_Actuals_FC_Consol()
'
' Copy_FC_to_Consol Macro
' Forecast data will NOT always have a Group ID (there may be blanks) so pulling in Actuals first
' macro right above: Sub Copy_Actuals_Consol_to_Actuals_FC_Consol()


Application.ScreenUpdating = False
Sheets("FC Details").Select
Range("A2:E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

' Switch back and paste values (this section copied in from new copy tableJE)to replace code below


Sheets("Actuals and FC Consol").Select

' inserting new test code

Dim LastRow1 As Long
LastRow1 = Range("A:F").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A" & LastRow1).Select
Selection.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Range("A2").Select
' Range(Selection, Selection.End(xlDown)).Select
' Range("A3").Select
' Selection.End(xlDown).Select
' ActiveCell.Offset(1, 0).Range("A1").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



' Range("A2").Select
' ActiveCell.Offset(1, 0).Range("A1").Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.End(xlDown).Select
' ActiveCell.Offset(1, 0).Range("A1").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False




' Copy down formula for Vlookup of Division name

' Range("C2").Select
' ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Dept look-up '!C[-1]:C[1],3,0)"
' Range("C2").Select
' Selection.AutoFill Destination:=Range("C2:C8959")
' Range("C2:C8959").Select
' Range("A1").Select

''' New Copy Down formula


Range("C2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Dept look-up '!C[-1]:C[1],3,0)"
Range("C2").Select
Dim Division_LastRow As Long
Division_LastRow = Range("A:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("C2:C" & Division_LastRow).FillDown


Columns("E:F").Select
Selection.Style = "Comma"
Call Refresh_Pivot


End Sub


Sub Refresh_Pivot()
Sheets("PT").Select
Range("A5").Select
Application.Calculation = xlAutomatic
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
MsgBox "Done"
End Sub

[snb]

Can you post the file here, please ?

Start removing all 'select' s' and 'activate' s'
Remove double code.
Avoid 'copy/cut paste' in VBA.

[mdmackillop]

Note that your continuation line is not commented out and will fail

' Range("A2").Select
' Range(Selection, Selection.End(xlDown)).Select
' Range("A3").Select
' Selection.End(xlDown).Select
' ActiveCell.Offset(1, 0).Range("A1").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

[sschwant]

Can you post the file here, please ?

Start removing all 'select' s' and 'activate' s'
Remove double code.
Avoid 'copy/cut paste' in VBA.

Are you suggesting use Activate rather than Select? Or never use either? If never ... why not?

Why avoid copy / paste or cut paste in VBA ?

Thanks!!

Steve

[sschwant]

Are you looking at this Sub?



Sub new_copy_tbl_JE()


Application.ScreenUpdating = False
Sheets("tblJE").Select
Range("E2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

'' Switch to Actuals Consol tab - - copy and append TblJE to APQry dataset at bottom row


Sheets("Actuals Consol").Select
'' insert newly tested code
Dim LastRow As Long
LastRow = Range("A:E").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A" & LastRow).Select
Selection.Offset(1, 0).Range("A1").Select



'' Range("A2").Select
'' Range(Selection, Selection.End(xlDown)).Select
'' Range("A3").Select
'' Selection.End(xlDown).Select
'' ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call Insert_1_Col_for_FCST
End Sub

This routine is working okay. Rather than trying to use a previous approach of xldown, and offset .... I'm using a Defined range which includes the last row ... to identify where to paste values ...

Thanks!

Steve

[mdmackillop]

Sub Copy_FC_Details_to_Actuals_FC_Consol()

[snb]

E.g. You should write


Sheets("AP Qry Dataset").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
as


Sheets("AP Qry Dataset").Rows(1).Delete

Although I doubt whether the deleting of row 1 serves any purpose.

[sschwant]

Sub Copy_FC_Details_to_Actuals_FC_Consol()

Got it ... thanks. I think it's okay... I meant to abandon that section of code preferring to use a defined range w/ a Dim statement to identify the last row of the Actuals Consol data, then offsetting one row and appending the FC data below.

The _ on that line should mitigate the need to place the asterisk ' on the line below as it reads all as one line (asterisk above).

Regards,

Steve

p.s., I have a new post on MS Answers.com forum that I updated this a.m. which might help clarify a bit (I hope).

http://answers.microsoft.com/en-us/office/forum/office_2010-excel/how-to-redirect-a-macro-if-an-auto-filter-criteria/3cd539e6-de80-4646-9d76-7a6aa9acd136?msgId=ca27ca2e-7813-4de0-ae35-f6c9aa491930&rtAction=1466516019311

[sschwant]

Not sure I can ... think there's a file size constraint of 1 MB. Which is why I posted to OneDrive. Zipped up it's still ~ 2+ Megs.

[sschwant]

E.g. You should write


Sheets("AP Qry Dataset").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
as


Sheets("AP Qry Dataset").Rows(1).Delete

Although I doubt whether the deleting of row 1 serves any purpose.

TY! This is likely a good coding idea, but not the crux of my problem.

[SamT]

Your first sub with Select-Selections's and unneeded default properties removed. Try deleting all comments after you read them


Sub Stage_AP_data_step_1()
'
' AP_data Macro
' After running Qry_Mrg in NCT database, copy paste values into the "AP Qry Dataset" tab onto cell A1.
' This section rearranges the columns prior to merging AP & JE data on "Actuals Consol" tab.


Application.Calculation = xlManual
Application.ScreenUpdating = False

With Sheets("AP Qry Dataset")
.Rows("1:1").Delete Shift:=xlUp

' Next 2 lines make entire sheet = Used Range
'Cells.Select
'Selection.Font.Size = 10
.UsedRange.Font.Size = 10

'Rows("1:1") Makes UsedRange All Columns wide
With Intersect(.UsedRange, .Rows(1))
.HorizontalAlignment = xlCenter
.WrapText = True
.Font.Bold = True
.Font.Size = .Font.Size + 1 'Added, Should also add Bottom Border
End With

.Range("A2").Select 'Select needed for freezepanes
ActiveWindow.FreezePanes = False
ActiveWindow.FreezePanes = True

' Next 2 lines might make entire sheet = Used Range
'Cells.Select
'Cells.EntireColumn.AutoFit
'Autofitting moved to after all columns rearranged

.Columns("E:E").Cut
.Range("R1").Select
ActiveSheet.Paste

.Range("S1").Value = "Div"

.Columns("N:O").Cut
.Range("T1").Insert Shift:=xlToRight

.Range("O1:S1").Color = 65535 'This works? Hmmmmn.
'Isn't this color white? The same as Color=None?

.UsedRange.EntireColumn.AutoFit

End With 'Worksheet

Stage_JE_raw_Data_Step2 'Call not needed
End Sub

[mdmackillop]

Hi Sam

.Range("A2").Select 'Select needed for freezepanes

Try

With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True

[SamT]

Thanks for the tip.

[snb]

@SamT

I think a lot of code is redundant when a listobject is being defined/inserted.

[SamT]

:rofl: You think a lot of code is redundant. Period. That's why I study your code, it's so nuanced.

I'm just a simple country boy, I like my code to read like a comic book.

If I was teaching an advanced VBA course, all the quiz's would just be a piece of your code and the instructions to explain how it works and translate it to 'comic book' code.

[snb]

In this case I formulated a condition: if the user would apply a listobject. I thought you were a fan of listobjects .... :whistle:

That's why I like Crazy Kat: Icecream, icecream !! Why do you scream ???

[SamT]

Don't know anything about ListObjects.