Macro only works every other time..... Why?

Mr_Musings · Sep 26, 2012

Hi All

Im a fairly novice user of VBA. i have created a macro that is the culmination of a series of macros, as every time i did it in one go i managed to break it. however as smaller macro's i could manage them better. in the middle i have possible the simplest macro which is to copy a range in one worksheet and copy it to another worksheet. Code is as follows

PHP:

Sub No7_MoveDataToAnalysis()
'
' No7_MoveDataToAnalysis Macro
'
    Sheets("Data").Select
    Range("B1:B3500").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Analysis").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
'
    End Sub

This works perfectly when i run this Macro on its own. However when i run it as part of the "Parent" macro, it only works every 2nd time.

why would this be and how do i correct this.

thanks
tom

Andrew Poulsom · Sep 27, 2012

Please post the entire procedure that includes the call to No7_MoveDataToAnalysis.

Mr_Musings · Sep 27, 2012

Hi

the full task is:

PHP:

Sub No1_SelectDataForDedupe()
'
' No1_SelectDataForDedupe Macro
'
'
    Sheets("Data").Select
    Columns("A:I").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$I$3500").AutoFilter Field:=1, Criteria1:=Array( _
        "Adviser", "Total - Adviser", "Total - Company", "="), Operator:=xlFilterValues
End Sub
Sub No2_DedupeData()
'
' No2_DedupeData Macro
'
'
    Sheets("Data").Select
    Rows("2:3500").Select
    Selection.Delete Shift:=xlUp
End Sub
Sub No3_ShowAllData()
'
' No3_ShowAllData Macro
'
'
    Sheets("Data").Select
    ActiveSheet.Range("$A$1:$I$3500").AutoFilter Field:=1
End Sub
Sub No4_AddFormulaAndDuplicate()
'
' No4_AddFormulaAndDuplicate Macro
'
'
    Range("I2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-5]=""ISA"",IF(COUNTIFS(R2C2:R3500C2,RC[-7],R2C4:R3500C4,""GIA"",R2C5:R3500C5,RC[-4])>0,""---"",SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])),IF(RC[-5]=""GIA"",IF(COUNTIFS(R2C2:R3500C2,RC[-7],R2C4:R3500C4,""ISA"",R2C5:R3500C5,RC[-4])>0,SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])+SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,""Elevate ISA"",R2C5:R3500C5,RC[-4]),SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])),SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])))"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I3500")
    Range("I2:I3500").Select
End Sub
Sub No5_PasteValuesAndRemoveDuplicates()
'
' No5_PasteValuesAndRemoveDuplicates Macro
'
'
    Columns("I:I").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("A:I").Select
    Range("I1").Activate
    ActiveSheet.Range("$A$1:$I$3500").RemoveDuplicates Columns:=Array(2, 4, 5), _
        Header:=xlYes
    Columns("I:I").Select
    Selection.Copy
    Columns("H:H").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
End Sub
Sub No6_DeleteNullValues()
'
' No6_DeleteNullValues Macro
'
'
    ActiveSheet.Range("$A$1:$I$3500").AutoFilter Field:=8, Criteria1:="---"
    Rows("2:3500").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$I$3500").AutoFilter Field:=8
    Range("A1").Select
End Sub
Sub No7_MoveDataToAnalysis()
'
' No7_MoveDataToAnalysis Macro
'
    Sheets("Data").Range("B1:B3500").Copy
    Sheets("Analysis").Range("A2").PasteSpecial Paste:=xlPasteValues
   
'
    End Sub
    
 
 
Sub No8_RemoveDuplicates()
'
' No8_RemoveDuplicates Macro
'
'
    Sheets("Analysis").Select
    Columns("A:A").Select
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Sub No9_CopyFormulasDown()
'
' No9_CopyFormulasDown Macro
'
'
 
    Sheets("Analysis").Select
    Range("B3:V3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range("B3:V3").Select
    Application.CutCopyMode = False
    Range("B3:V3").Select
    Selection.Copy
    Range("B3:V3500").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("J24").Select
End Sub
Sub No10_PasteValues()
'
' No10_PasteValues Macro
'
'
    Sheets("Analysis").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    End Sub
Sub No11_SortAndRemoveNA()
'
' No11_SortAndRemoveNA Macro
'
'
    Range("B2").Select
    ActiveSheet.Range("$A$2:$V$3500").AutoFilter Field:=2, Criteria1:="#N/A"
    Rows("3:3500").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$2:$V$180").AutoFilter Field:=2
    ActiveWorkbook.Worksheets("Analysis").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Analysis").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B2:B3500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Analysis").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub Home()
'
' Home Macro
'
'
    Sheets("Home").Select
    Range("A1").Select
End Sub
Sub RunCollation()
'
' RunCollation Macro
'
'
   Application.Run ("No1_SelectDataForDedupe")
   Application.Run ("No2_dedupedata")
   Application.Run ("No3_ShowAllData")
   Application.Run ("No4_AddFormulaAndDuplicate")
   Application.Run ("No5_PasteValuesAndRemoveDuplicates")
   Application.Run ("No6_DeleteNullValues")
   Application.Run ("No7_MoveDataToAnalysis")
   Application.Run ("No8_RemoveDuplicates")
   Application.Run ("No8_AddFormulaToAnalysis")
   Application.Run ("No9_CopyFormulasDown")
   Application.Run ("No10_PasteValues")
   Application.Run ("No11_SortAndRemoveNA")
   Application.Run ("Last_AdviserName")
   Application.Run ("Home")
   
End Sub
Sub No8_AddFormulaToAnalysis()
'
' No8_AddFormulaToAnalysis Macro
'
'
    Range("C3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3),"""")"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3),"""")"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3),"""")"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C3),"""")"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8),"""")"
    Range("I3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8),"""")"
    Range("J3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8),"""")"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C8),"""")"
    Range("L3").Select
    ActiveCell.FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13),"""")"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13),"""")"
    Range("O3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13),"""")"
    Range("P3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,Analysis!RC1,Data!R2C4:R3500C4,Analysis!R2C,Data!R2C5:R3500C5,Analysis!R1C13),"""")"
    Range("Q3").Select
    ActiveCell.FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
    Range("R3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(RC[-15],RC[-10],RC[-5])>0,SUM(RC[-15],RC[-10],RC[-5]),"""")"
    Range("S3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(RC[-15],RC[-10],RC[-5])>0,SUM(RC[-15],RC[-10],RC[-5]),"""")"
    Range("T3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(RC[-15],RC[-10],RC[-5])>0,SUM(RC[-15],RC[-10],RC[-5]),"""")"
    Range("U3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(RC[-15],RC[-10],RC[-5])>0,SUM(RC[-15],RC[-10],RC[-5]),"""")"
    Range("V3").Select
    ActiveCell.FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
    Range("W3").Select
End Sub
Sub Last_AdviserName()
'
' Last_AdviserName Macro
'
'
    Sheets("Data").Select
    Columns("A:A").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    Sheets("Analysis").Select
    Range("B3").Select
        ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-1],Data!R2C2:R3500C10,9,0)),"""",VLOOKUP(RC[-1],Data!R2C2:R3500C10,9,0))"
    Range("B3").Select
    Selection.AutoFill Destination:=Range("B3:B3500")
    Columns("B:B").Select
     Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
End Sub

Andrew Poulsom · Sep 27, 2012

Sorry, I can't see anything there that would cause your procedure to run only every other time. What evidence do you have? Do the other called procedures run every time? What is causing the data on sheet Data to change?

Mr_Musings · Sep 27, 2012

after the first time of running the function, the information on the sheet "Data" doesnt actually change. the only evidence i have it that the times it "fails", essentially it just pastes blank cells in the "Analysis" Sheer then everything after that fails.

Andrew Poulsom · Sep 27, 2012

What causes the information on sheet "Data" to change? Your code only filters it and deletes unwanted data. It seems that the procedure No7_MoveDataToAnalysis is running every time, but sometimes there is nothing to paste.

RoryA · Sep 27, 2012

The only thing I can see is that there are a lot of unqualified range references there so perhaps the wrong sheet is active at some point. I think this is equivalent:

Code:

Sub No1_SelectDataForDedupe()'
' No1_SelectDataForDedupe Macro
'
'
    With Sheets("Data")
        .Columns("A:I").AutoFilter
        .Range("$A$1:$I$3500").AutoFilter Field:=1, Criteria1:=Array("Adviser", "Total - Adviser", "Total - Company", "="), _
                                                    Operator:=xlFilterValues
    End With
End Sub
Sub No2_DedupeData()
'
' No2_DedupeData Macro
'
'
    Sheets("Data").Rows("2:3500").Delete Shift:=xlUp
End Sub
Sub No3_ShowAllData()
'
' No3_ShowAllData Macro
'
'
    Sheets("Data").Range("$A$1:$I$3500").AutoFilter Field:=1
End Sub
Sub No4_AddFormulaAndDuplicate()
'
' No4_AddFormulaAndDuplicate Macro
'
'
    With Sheets("Data")
        .Range("I2").FormulaR1C1 = _
        "=IF(RC[-5]=""ISA"",IF(COUNTIFS(R2C2:R3500C2,RC[-7],R2C4:R3500C4,""GIA"",R2C5:R3500C5,RC[-4])>0,""---"",SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])),IF(RC[-5]=""GIA"",IF(COUNTIFS(R2C2:R3500C2,RC[-7],R2C4:R3500C4,""ISA"",R2C5:R3500C5,RC[-4])>0,SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])+SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,""Elevate ISA"",R2C5:R3500C5,RC[-4]),SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])),SUMIFS(R2C8:R3500C8,R2C2:R3500C2,RC[-7],R2C4:R3500C4,RC[-5],R2C5:R3500C5,RC[-4])))"
        .Range("I2").AutoFill Destination:=.Range("I2:I3500")
    End With
End Sub
Sub No5_PasteValuesAndRemoveDuplicates()
'
' No5_PasteValuesAndRemoveDuplicates Macro
'
'
    With Sheets("Data")
        With .Columns("I:I")
            .Copy
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End With
        .Range("$A$1:$I$3500").RemoveDuplicates Columns:=Array(2, 4, 5), Header:=xlYes
        .Columns("I:I").Copy
        .Columns("H:H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Columns("I:I").EntireColumn.Hidden = True
    End With
End Sub
Sub No6_DeleteNullValues()
'
' No6_DeleteNullValues Macro
'
'
    With Sheets("Data").Range("$A$1:$I$3500")
        .AutoFilter Field:=8, Criteria1:="---"
        .Resize(.Rows.Count - 1).Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter Field:=8
    End With
End Sub
Sub No7_MoveDataToAnalysis()
'
' No7_MoveDataToAnalysis Macro
'
    Sheets("Data").Range("B1:B3500").Copy
    Sheets("Analysis").Range("A2").PasteSpecial Paste:=xlPasteValues


    '
End Sub






Sub No8_RemoveDuplicates()
'
' No8_RemoveDuplicates Macro
'
'
    Sheets("Analysis").Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Sub No9_CopyFormulasDown()
'
' No9_CopyFormulasDown Macro
'
'


    With Sheets("Analysis")
        .Range("B3:V3").Copy
        .Range("B3:V3500").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
    End With
End Sub
Sub No10_PasteValues()
'
' No10_PasteValues Macro
'
'
    With Sheets("Analysis").UsedRange
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
    Application.CutCopyMode = False


End Sub
Sub No11_SortAndRemoveNA()
'
' No11_SortAndRemoveNA Macro
'
'
    Dim ws                    As Worksheet
    Set ws = ActiveWorkbook.Worksheets("Analysis")
    With ws
        With .Range("$A$2:$V$3500")
            .AutoFilter Field:=2, Criteria1:="#N/A"
            .Resize(.Rows.Count - 1).Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter Field:=2
        End With
        With .AutoFilter.Sort
            With .SortFields
                .Clear
                .Add Key:=ws.Range("B2:B3500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub
Sub Home()
'
' Home Macro
'
'
    With Sheets("Home")
        .Select
        .Range("A1").Select
    End With
End Sub
Sub RunCollation()
'
' RunCollation Macro
'
'
    Call No1_SelectDataForDedupe
    Call No2_DedupeData
    Call No3_ShowAllData
    Call No4_AddFormulaAndDuplicate
    Call No5_PasteValuesAndRemoveDuplicates
    Call No6_DeleteNullValues
    Call No7_MoveDataToAnalysis
    Call No8_RemoveDuplicates
    Call No8_AddFormulaToAnalysis
    Call No9_CopyFormulasDown
    Call No10_PasteValues
    Call No11_SortAndRemoveNA
    Call Last_AdviserName
    Call Home


End Sub
Sub No8_AddFormulaToAnalysis()
'
' No8_AddFormulaToAnalysis Macro
'
'
    With Sheets("Analysis")
        .Range("C3:F3").FormulaR1C1 = _
    "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,RC1,Data!R2C4:R3500C4,R2C,Data!R2C5:R3500C5,R1C3)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,RC1,Data!R2C4:R3500C4,R2C,Data!R2C5:R3500C5,R1C3),"""")"
        .Range("G3").FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
        .Range("H3:K3").FormulaR1C1 = _
    "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,RC1,Data!R2C4:R3500C4,R2C,Data!R2C5:R3500C5,R1C8)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,RC1,Data!R2C4:R3500C4,R2C,Data!R2C5:R3500C5,R1C8),"""")"
        .Range("L3").FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
        .Range("M3:P3").FormulaR1C1 = _
    "=IF(SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,RC1,Data!R2C4:R3500C4,R2C,Data!R2C5:R3500C5,R1C13)>0,SUMIFS(Data!R2C8:R3500C8,Data!R2C2:R3500C2,RC1,Data!R2C4:R3500C4,R2C,Data!R2C5:R3500C5,R1C13),"""")"
        .Range("Q3,V3").FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-1])>0,SUM(RC[-4]:RC[-1]),"""")"
        .Range("R3:U3").FormulaR1C1 = "=IF(SUM(RC[-15],RC[-10],RC[-5])>0,SUM(RC[-15],RC[-10],RC[-5]),"""")"
    End With
End Sub
Sub Last_AdviserName()
'
' Last_AdviserName Macro
'
'
    With Sheets("Data")
        .Columns("A:A").Copy
        .Columns("J:J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Columns("J:J").EntireColumn.Hidden = True
    End With
    With Sheets("Analysis")
        .Range("B3").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],Data!R2C2:R3500C10,9,0)),"""",VLOOKUP(RC[-1],Data!R2C2:R3500C10,9,0))"
        .Range("B3").AutoFill Destination:=.Range("B3:B3500")
        With .Columns("B:B")
            .Copy
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
    End With
End Sub

tracycamp · Jan 28, 2015

I know this is an old thread, but I just experienced the same problem and wanted to share what was causing it. In my file, I had a user interface on one tab where certain values could be specified. These values would then be referenced on another tab where I had a linear program set up. While working with a different file, I had set calculations to manual. So, a change in values on the user sheet wouldn't be reflected in the linear program constraints until the end of the macro, which for some reason would cause it to calculate. The next time I ran it, I would get the expected result. So, the problem wasn't with the macro at all but with the manual calculations setting.

HiGH_ZeRO · Feb 20, 2018

Hello Everybody, I'm having the same problem with my macro it works every second time, I do checked this several times. This macro is splitting up data to multiple workbooks or sheets. In the first run it creating files only with title row. And after I delete these files and run it again it works as should.
Please help me to found out what is wrong.
Here is the code

Code:

Option Explicit

Public Sub SPLIT_SHEETS()


    Dim key_col, wb_sh_split As Integer
    Dim last_col_descr, rng_col_letter, sheet_name, del_col As String
      
        If ActiveSheet.AutoFilterMode Then
            If ActiveSheet.FilterMode Then
                ActiveSheet.ShowAllData
                Debug.Print ActiveWorkbook.name & ". " & ActiveSheet.name & ". Filter has been cleared"
            End If
        End If
		
	Call backup_workbook("BACKUP")
    
    last_col_descr = "Change Number"
    del_col = "KEY"
    
    Cells.Find(what:=last_col_descr, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    rng_col_letter = Split(ActiveCell(1).Address(1, 0), "$")(0)
    Cells.Find(what:=del_col, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    key_col = ActiveCell.column
    
    sheet_name = ActiveSheet.name
    Debug.Print sheet_name; key_col
    
    wb_sh_split = MsgBox("Do you want to split data to workbooks? Yes to workbooks, No to sheets", vbYesNoCancel, "Please make your choise.")
        If wb_sh_split = vbYes Then
                wb_sh_split = 1
                Call create_subdir
                       
            ElseIf wb_sh_split = vbNo Then
                wb_sh_split = 2
                
            ElseIf wb_sh_split = vbCancel Then
                Exit Sub
        End If
    
    Call SPLIT_SHEETS_CORE(rng_col_letter, sheet_name, del_col, 1, wb_sh_split)
    
     With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    ActiveWorkbook.Save
End Sub
Function SPLIT_SHEETS_CORE(rng_col_letter, sheet_name, del_column As String, vcol, wb_sh_split As Integer)
    Dim icol, lr As Long
    Dim ws As Worksheet
    Dim titlerow, i As Integer
    Dim myarr As Variant
    Dim strdir, title As String


    'vcol = 1                                          'vcol =1, the number 1 is the column number that you want to split the data based on.
    strdir = ActiveWorkbook.Path & "\" & "Splitted" & "\"
    Set ws = Sheets(sheet_name)
 
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).row
    title = "A1:" & rng_col_letter & "1"
    titlerow = ws.Range(title).Cells(1).row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"


    For i = 2 To lr
        On Error Resume Next
            If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
                ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
            End If
    Next
    
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    
    If wb_sh_split = 1 Then
            For i = 2 To UBound(myarr)
                ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
                    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
                         With Workbooks.Add
                            With .Sheets.Add(Before:=.Sheets(1))
                                .name = myarr(i) & ""
                            End With
                         End With
                        
                            Application.DisplayAlerts = False
                            ActiveWorkbook.Worksheets("Sheet1").Delete
                            Application.DisplayAlerts = True
                            ActiveWorkbook.SaveAs Filename:=strdir & myarr(i) & ""
                
                        Else
        
                            Sheets(myarr(i) & "").Move After:=Worksheets(Worksheets.Count)
                        End If
                        
                ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
                Sheets(myarr(i) & "").Columns.AutoFit
            
                Call match_and_delete(del_column)
            
                ActiveWorkbook.Close SaveChanges:=True
            Next
        
        ElseIf wb_sh_split = 2 Then
        
            For i = 2 To UBound(myarr)
                ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
                    
                    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
                        Sheets.Add(After:=Worksheets(Worksheets.Count)).name = myarr(i) & ""
                    Else
                        Sheets(myarr(i) & "").Move After:=Worksheets(Worksheets.Count)
                    End If
                
                ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
                Sheets(myarr(i) & "").Columns.AutoFit
            Next
        
        End If
        
    ws.AutoFilterMode = False
    ws.Activate
    
End Function
Function create_subdir()


    Dim strdir As String
    strdir = ActiveWorkbook.Path & "\" & "Splitted" & "\"
        If Dir(strdir, vbDirectory) = "" Then
            MkDir strdir
        Else
    End If


End Function
Function match_and_delete(col_name As String)
    Dim i As Integer


    On Error GoTo ColumnNotExist
    i = Application.WorksheetFunction.Match(col_name, Range("A1:AZ1"), 0)
        
    If i > 0 Then
    
        Debug.Print ActiveWorkbook.name & "Column number is " & i
        Cells.Find(what:=col_name, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select
        Selection.EntireColumn.Delete
        Debug.Print ActiveWorkbook.name & ". Column (" & col_name & ") has been deleted."
        
    End If
    Exit Function
    
ColumnNotExist:
  Debug.Print ActiveWorkbook.name & ". Column (" & col_name & ") does not exist and nothing has been done."
  Err.Clear
    
End Function
Public Function backup_workbook(backup_folder As String)


    Dim strdir As String
    Dim backup_name As String
    
    strdir = ActiveWorkbook.Path & "\" & backup_folder & "\"
    backup_name = "Backup_" & ActiveWorkbook.name


    If Dir(strdir, vbDirectory) = "" Then
    
        MkDir strdir
        Debug.Print ActiveWorkbook.name & ". Backup folder has been created."


    Else
    
        Debug.Print ActiveWorkbook.name & ". Backup folder exists."


    End If


    ActiveWorkbook.SaveCopyAs strdir & backup_name
    Debug.Print ActiveWorkbook.name & ". Backup file ( " & backup_name & " )has been successfully created. Backup located in subfolder named " & backup_folder


End Function

Macro only works every other time..... Why?

Mr_Musings

Board Regular

Andrew Poulsom

MrExcel MVP

Excel Facts

Mr_Musings

Board Regular

Andrew Poulsom

MrExcel MVP

Mr_Musings

Board Regular

Andrew Poulsom

MrExcel MVP

RoryA

MrExcel MVP, Moderator

tracycamp

New Member

HiGH_ZeRO

New Member

Similar threads

Forum statistics

Share this page

Macro only works every other time..... Why?

Board Regular

MrExcel MVP

Excel Facts

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

MrExcel MVP, Moderator

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock