Home » excel » Excel VBA code, one macro works when ran by itself, but debugs when ran in a group

Excel VBA code, one macro works when ran by itself, but debugs when ran in a group

Posted by: admin May 14, 2020 Leave a comment

Questions:

My program works by calling a number of macros as such:

Sub Start()

Call ClearAll
Call Sales_Download
Call Copy_Sales
Call Receipt_Download
Call Copy_Receipt
Call Copy1
Call Sales_Summary
Call Copy2
Call Receipt_Summary

End Sub

My program breaks at the copy2, which is essentially an exact replica of copy1 wich works fine. When copy2 is ran by itself it works perfectly, but when I attempt to run the entire program it debugs. The bolded line is where the debug happens.

Sub Copy2()

 ' Copies all data from Receipt Download tab for each location, and saves in a seperate folder

Dim i As Long
Dim lngLastRow As Long, lngPasteRow As Long

'Find the last row to search through
lngLastRow = Sheets("Receipt_Download").Range("J65535").End(xlUp).Row

'Initialize the Paste Row
lngPasteRow = 2
Dim rng As Range
Dim c As Range
Dim endrow
Dim strName As String
Dim ws As Worksheet
Dim j As Long
endrow = Sheets("names").Range("A65000").End(xlUp).Row
Set rng = Sheets("names").Range("A2:A" & endrow)
j = 1
FBO = strName


For Each c In rng


For i = 2 To lngLastRow
    strName = c.Value
    If Sheets("Receipt_Download").Range("J" & i).Value = strName Then
        Sheets("Receipt_Download").Select
        Range("A" & i & ":IV" & i).Copy
        Sheets("Summary").Select
        Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select
        ActiveSheet.Paste
        lngPasteRow = lngPasteRow + 1

    End If
Next i
j = j + 1
        Sheets("Receipt_Download").Select
        Rows("1:1").Select
        Selection.Copy
        Sheets("Summary").Select
        Rows("1:1").Select
        ActiveSheet.Paste
        Columns("D:E").Select
        Selection.NumberFormat = "m/d/yyyy"
        Sheets("Summary").Select
        Range("B25000").Select
        ActiveCell.FormulaR1C1 = "Grand Total"
        Range("B25000").Select
        Selection.Font.Bold = True
        Columns("G:G").Select
        Selection.Insert Shift:=xlToRight
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
        Range("G1").Select
        Selection.AutoFill Destination:=Range("G1:G24950")
        Range("G25000").Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
        Range("G25000").Select
        Selection.Copy
        Range("F25000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Columns("G:G").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Sheets("Summary").Select
        Range("F25000").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Names").Select
        With Columns("B")
        .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
        End With
        ActiveSheet.Paste
        Sheets("Summary").Select
        Range("b1:b30000").Select
        For Each Cell In Selection
        If Cell.Value = "" Then
        Cell.ClearContents
        End If
        Next Cell
        Range("b1:b30000").Select
        Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Sheets("Summary").Select
        Range("D2").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Names").Select
        ***With Columns("C")
        .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate***
        End With
        ActiveSheet.Paste
        Sheets("Summary").Select
        Range("A1:Z5000").Select
        Selection.Copy
        Workbooks.Add
        ActiveSheet.Paste
        Range("A1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Application.CutCopyMode = False
        File = "C:\Documents and Settings\user\Desktop\New FBO\" & strName & "\" & strName & " Receipts.xls"
        ActiveWorkbook.SaveAs Filename:=File, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close
        IngPasteRow = IngPasteRow + 1
        Sheets("Summary").Select
        Selection.ClearContents
Next c

End Sub

I would really appreciate any help, I am certainly no VBA master and this has been quite troublesome.

How to&Answers:

Replace this part of your code

 Sheets("Summary").Select
 Range("D2").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Names").Select
 With Columns("C")
 .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
 End With
 ActiveSheet.Paste

with

Dim lRow As Long

With Sheets("Names")
    lRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1

    Sheets("Summary").Range("D2").Copy .Range("C" & lRow)
End With

Now try it.

Also few tips

  1. Avoid .Select and .Activate They are a major cause of errors
  2. Indent and appropriately comment your code. Your code is very difficult to read. If you don’t indent/comment your code, you will realize that you will not recognize your OWN code if you visit it say after a week 🙂

Answer:

In support of Siddharth’s answer above, I have take a portion of your code (up to where your break happens) and have indented and avoided the .Select and .Activate that he mentions. Hopefully this gives you a good start on how to make your code more readable for debugging and understanding.

For Each c In rng


    For i = 2 To lngLastRow

        strName = c.Value

        If Sheets("Receipt_Download").Range("J" & i).Value = strName Then

            Sheets("Receipt_Download").Range("A" & i & ":IV" & i).Copy _
                Destination:=Sheets("Summary").Range("A" & lngPasteRow & ":IV" & lngPasteRow)
            lngPasteRow = lngPasteRow + 1

        End If
Next i

j = j + 1

Sheets("Receipt_Download").Rows("1:1").Copy Destination:=Sheets("Summary").Rows("1:1")

With Sheets("Summary")

    .Columns("D:E").NumberFormat = "m/d/yyyy"

    With .Range("B25000")
        .Formula = "Grand Total"
        .Font.Bold = True
    End With

    .Columns("G:G").Insert Shift:=xlToRight

    With Range("G1")
        .FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
        .AutoFill Destination:=Range("G1:G24950")
    End With

    With ("G25000")
        .FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
        .Copy
    End With

    .Range("F25000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    .Columns("G:G").Delete Shift:=xlToLeft

    .Range("F25000").Copy Destination:=Sheets("Names").Columns("B").Find(what:="", after:=Sheets("Names").Cells(1, 1), LookIn:=xlValues)

End With