Adding IF statement to Row Delete

[HazatB]

Good Morning,

I am putting the final touches on my macro and have two issues I need help resolving.

1) I need to create a IF to a row delete since when there are no rows to delete I get and error. here is the line of code.

Range("A7:A" & LastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

2) If I have less rows in my old data then my new I have a macro that is supposed to compensate for this, however I am running into the problem of having to re-run the macro multiple times for it to finally grab all the new information. The code for that function is below.

Dim LastRow As Long
Dim wks1 As Worksheet
Dim wks2 As Worksheet

Set wks2 = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review")
Set wks1 = Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro")

LastRow = Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("A:E").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row
LastRow = Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("F:G").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row
LastRow = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("A:E").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row
LastRow = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("I:J").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row

Worksheets("Before n After Remap Review").Range("A7:E" & LastRow).Select
Selection.ClearContents

Worksheets("Before n After Remap Review").Range("I7:J" & LastRow).Select
Selection.ClearContents

Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("A1:E" & LastRow).Copy
Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("A7:E" & LastRow).PasteSpecial

Application.CutCopyMode = False

Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("F1:G" & LastRow).Copy
Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("I7:J" & LastRow).PasteSpecial

Application.CutCopyMode = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("F7").AutoFill Destination:=Range("F7:F" & LastRow), Type:=xlFillDefault
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("G7").AutoFill Destination:=Range("G7:G" & LastRow), Type:=xlFillDefault
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K7").AutoFill Destination:=Range("K7:K" & LastRow), Type:=xlFillDefault
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("L7").AutoFill Destination:=Range("L7:L" & LastRow), Type:=xlFillDefault
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("N7").AutoFill Destination:=Range("N7:N" & LastRow), Type:=xlFillDefault

Any assistance will be appreciated.

 

[JackDanIce]

Untested, try:

Dim wks1    As Worksheet
    Dim wks2    As Worksheet
    
    Dim x       As Long
    Dim var     As Variant
    Dim arr()   As Variant
    
    Set wks2 = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review")
    Set wks1 = Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro")

    Application.ScreenUpdating = False
    
    With wks2
        x = .Cells(.Rows.count, 1).End(xlUp).row
        .Range("A7:E" & x & ",I7:J" & x).ClearContents
    End With
    
    With wks1
        x = .Cells(.Rows.count, 1).End(xlUp).row
        arr = .Range("A1:E" & x).Value
        wks2.Cells(7, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Erase arr
        arr = .Range("I7:J" & x).Value
        wks2.Cells(7, 9).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Erase arr
        For Each var In Array(6, 7, 11, 12, 14)
            .Cells(7, CLng(var)).AutoFill destination:=.Cells(7, 7).Resize(x - 6)
        Next var
        On Error Resume Next
        .Cells(7, 1).Resize(x - 6).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    End With

    Application.ScreenUpdating = True

 

[HazatB]

Thank you I am testing it now. How do you place a Code posted in the format you have, I would like to put it in that format for future posts.

 

[JackDanIce]

https://www.mrexcel.com/forum/board-announcements/515787-how-post-your-vba-code.html

Under Forum -> Board Announcements -> Please read before posting