Subs called one after the other by the main sub crash, but called manually one by one, work perfectl-CodePudding

I have a strange issue. I have a set of 12 subs to prepare an external Excel file. When I group them together in one main sub, and execute, they somehow crash and the Excel file has wrong data in the end. But when I go to the VBA view and execute one by one, all is correct. Attached are the screens of correct (manual) execution and the corrupt (automatic) execution outcome. Below is the code of the subs:

Sub A_PZ_ZST_INB_MVT()
Workbooks.Open ("K:\WAW\Warehouse\ZSMOPL\KomunikatyOS,XML\ZST_INB_MVT.XLSX")
End Sub

Sub B_PZ_konwertujmaterial()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
[C:C].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
End With
End Sub

Sub C_PZ_konwertujilosc()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
[F:F].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
End With
End Sub

Sub D_PZ_kolumny()
Workbooks("ZST_INB_MVT.XLSX").Worksheets("Sheet1").Range("A:A").EntireColumn.Insert
Workbooks("ZST_INB_MVT.XLSX").Worksheets("Sheet1").Range("J:J").EntireColumn.Insert
[J:J].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
    End With
End Sub

Sub E_PZ_prawdafalsz()
    Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Dim i As Integer
    NumRows = Range("D1", Range("D1").End(xlDown)).Rows.Count
  
    Range("A2").FormulaR1C1 = "=RC[2]=R[-1]C[2]"
    Range("A2").Select
    Selection.Copy
    For i = 3 To NumRows
    Range(Cells(3, 1), Cells(i, 1)).Select
    ActiveSheet.Paste
    Next i
End Sub

Sub F_PZ_kopiujinvoice()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim myRow As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column C with an entry
    LastRow = Cells(Rows.Count, "C").End(xlUp).Row
    
'   Loop through all rows in column C
    For myRow = 1 To LastRow
'       Check to see if current row is blank and row below is populated
        If Cells(myRow, "C") = "" And Cells(myRow   1, "C") <> "" Then
            Cells(myRow, "C") = Cells(myRow   1, "C")
        End If
    Next myRow
    Application.ScreenUpdating = True
End Sub

Sub G_PZ_konwertujinvoice()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
[C:C].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
End With
End Sub

Sub H_PZ_usunduplikaty()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Dim i As Long
    For i = Cells(Rows.Count, "e").End(xlUp).Row To 1 Step -1
    If Cells(i, "e") = "" Then Cells(i, "e").EntireRow.Delete xlUp
    Next i
End Sub

Sub I_PZ_prawdafalsz2()
    Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Worksheets("Sheet1").Columns(1).ClearContents
    Dim i As Integer
    NumRows = Range("b1", Range("b1").End(xlDown)).Rows.Count
      Range("A2").FormulaR1C1 = "=RC[2]=R[-1]C[2]"
    Range("A2").Select
    Selection.Copy
    For i = 3 To NumRows
    Range(Cells(3, 1), Cells(i, 1)).Select
    ActiveSheet.Paste
    Next i
End Sub

Sub J_PZ_puste_wiersze()
    Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Dim i As Long
    Dim xLast As Long
    Dim xRng As Range
    Dim xTxt As String
        NumRows = Range(("D2"), Range("D2").End(xlDown)).Rows.Count
    On Error Resume Next
    xTxt = Application.ActiveWindow.RangeSelection.Address
    Set xRng = Application.Range("$A$2:$A$100")
        xLast = xRng.Rows.Count
    For i = xLast To 1 Step -1
      If InStr(1, xRng.Cells(i, 1).Value, False) > 0 Then
        Rows(xRng.Cells(i, 1).Row).Insert Shift:=xlDown
      End If
    Next
End Sub

Sub K_PZ_kopiujinvoice()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
Dim lr As Long
With ActiveSheet
  lr = .Columns("C").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  On Error Resume Next
  With .Range("C2:C100" & lr)
    .SpecialCells(xlCellTypeBlanks).Formula = "=R[1]C"
    .Value = .Value
  End With
  On Error GoTo 0
End With
Application.ScreenUpdating = True

End Sub

Sub L_PZ_kopiujvendor()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
Dim lr As Long
With ActiveSheet
  lr = .Columns("B").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  On Error Resume Next
  With .Range("B2:B100" & lr)
    .SpecialCells(xlCellTypeBlanks).Formula = "=R[1]C"
    .Value = .Value
  End With
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

And the main sub which groups them all:

Sub przyjecie()
    A_PZ_ZST_INB_MVT
    B_PZ_konwertujmaterial
    C_PZ_konwertujilosc
    D_PZ_kolumny
    E_PZ_prawdafalsz
    F_PZ_kopiujinvoice
    G_PZ_konwertujinvoice
    H_PZ_usunduplikaty
    I_PZ_prawdafalsz2
    J_PZ_puste_wiersze
    K_PZ_kopiujinvoice
    L_PZ_kopiujvendor
End Sub

Correct execution Corrupt execution

CodePudding user response：

SOLVED: It turns out that the functionRows.Insert was actually pasting the function stored in the clipboard from the previous sub. I put Application.CutCopyMode = False and it solved my issue.

Thanks

CodePudding user response：

All those procedures could be combined into one.
Using Select could also open a whole world of hurt if someone accidently changes the active sheet while the code is running.
You also use three or four different methods to find the last row.

Much better to open the workbook and assign it to a variable, then use that reference in your code. Same with the sheets - no need to select it first.

Obligatory link to post: how-to-avoid-using-select-in-excel-vba

With that said, here's a re-write of your code. It's not perfect as I've just followed the order of your procedures, but will hopefully show a better way.

Public Sub Test()

    'Covers A_PZ_ZST_INB_MVT()
    ''''''''''''''''''''''''''
    Dim wrkBk As Workbook
    Set wrkBk = Workbooks.Open("K:\WAW\Warehouse\ZSMOPL\KomunikatyOS,XML\ZST_INB_MVT.XLSX")
        
    With wrkBk.Worksheets("Sheet1")
        
        'Covers B_PZ_konwertujmaterial() and C_PZ_konwertujilosc()
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With .Range("C:C,F:F")
            .NumberFormat = "General"
            .Value = .Value
        End With
        
        'Covers D_PZ_kolumny()
        ''''''''''''''''''''''
        .Columns(1).Insert Shift:=xlToRight
        .Columns(10).Insert Shift:=xlToRight
        With .Range("J:J")
            .NumberFormat = "General"
            .Value = .Value
        End With
        
        'Covers E_PZ_prawdafalsz()
        ''''''''''''''''''''''''''
        Dim NumRows As Long
        NumRows = .Cells(Rows.Count, 4).End(xlUp).Row 'Better to start from bottom and go up.
        .Range(.Cells(3, 1), .Cells(NumRows, 1)).FormulaR1C1 = "=RC[2]=R[-1]C[2]"
        
        'Covers F_PZ_kopiujinvoice()... probably a faster way to do this.
        ''''''''''''''''''''''''''''
        Dim LastRow As Long
        LastRow = .Cells(Rows.Count, 3).End(xlUp).Row
        
        Dim myRow As Long
        For myRow = 1 To LastRow
            If .Cells(myRow, 3) = "" And .Cells(myRow   1, 3) <> "" Then
                .Cells(myRow, 3) = .Cells(myRow   1, 3)
            End If
        Next myRow
        
        'Covers G_PZ_konwertujinvoice()
        '''''''''''''''''''''''''''''''
        With .Range("C:C")
            .NumberFormat = "General"
            .Value = .Value
        End With
        
        'Covers H_PZ_usunduplikaty() - probably faster to filter and delete.
        ''''''''''''''''''''''''''''
        For myRow = .Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
            If .Cells(myRow, 5) = "" Then .Rows(myRow).Delete Shift:=xlUp
        Next myRow
        
        'Covers I_PZ_prawdafalsz2()
        '''''''''''''''''''''''''''
        .Columns(1).ClearContents
        NumRows = .Cells(Rows.Count, 2).End(xlUp).Row
        .Range(.Cells(3, 1), .Cells(NumRows, 1)).FormulaR1C1 = "=RC[2]=R[-1]C[2]"
        
        'Covers J_PZ_puste_wiersze()
        ''''''''''''''''''''''''''''
        NumRows = .Cells(Rows.Count, 4).End(xlUp).Row
        For myRow = NumRows To 1 Step -1
            'Not sure what you're doing here.
            'Checking if columns A contains False and inserting a row?
            If .Cells(myRow, 1) = False Then
                .Rows(myRow).Insert Shift:=xlDown
            End If
        Next myRow
        
        'Covers K_PZ_kopiujinvoice()
        ''''''''''''''''''''''''''''
        NumRows = .Cells(Rows.Count, 3).End(xlUp).Row
        With .Range(.Cells(2, 3), .Cells(NumRows, 3))
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
            .Value = .Value
        End With
        
        'Covers L_PZ_kopiujvendor()
        '''''''''''''''''''''''''''
        NumRows = .Cells(Rows.Count, 2).End(xlUp).Row
        With .Range(.Cells(2, 2), .Cells(NumRows, 2))
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
            .Value = .Value
        End With
    End With

End Sub