asked on

Delete rows vba

After searching EE, I did not find anything. Trying to do:

I am using the following definations.

Set Wb1 = Workbooks.Open("C:\_Excel\CompareSheets\Book1.xls") 'Target file (gets the red)
Set Wb2 = Workbooks.Open("C:\_Excel\CompareSheets\Book3.xls") 'Master file
Set Ws1 = Wb1.Worksheets(1)
Set Ws2 = Wb2.Worksheets(1)
Ws1LR = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
Ws1LC = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Set ColRng = Ws1.Range("A2", Ws1.Cells(Ws1LR, Ws1LC))

Open in new window

Then based on this ColRng

For Each c In ColRng
    celladdress = c.Address
    If c <> Ws2.Range(celladdress) Then
        c.Interior.ColorIndex = 3
    Else
        c.Interior.ColorIndex = 0
    End If
Next c

Open in new window

So as a result, some cells in a row will have red cells and others not.

My goal is, before, it starts checking the next row down, to check the current row . Is there a way to check the row?
If there are no cells in this row that got highlighted red. Delete the entire row, shifting them up. Or after the process runs, go back and start removing rows that have no highlighted cells in it? Thus the only thing left would be rows that have a least one red highlighted cell in it. The code that highlights the cells red is below. Please advise and thanks.

Sub CompareTwoSheets()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Ws1LR As Long, Ws1LC As Long
Dim c As Range, ColRng As Range
With Application
'    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set Wb1 = Workbooks.Open("C:\_Excel\CompareSheets\Book1.xls") 'Target file (gets the red)
Set Wb2 = Workbooks.Open("C:\_Excel\CompareSheets\Book3.xls") 'Master file
Set Ws1 = Wb1.Worksheets(1)
Set Ws2 = Wb2.Worksheets(1)
Ws1LR = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
Ws1LC = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Set ColRng = Ws1.Range("A2", Ws1.Cells(Ws1LR, Ws1LC))

For Each c In ColRng
    celladdress = c.Address
    If c <> Ws2.Range(celladdress) Then
        c.Interior.ColorIndex = 3
    Else
        c.Interior.ColorIndex = 0
    End If
Next c
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Shums Faruk

Hi RWayneH,

Try below:

Sub CompareTwoSheets()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Ws1LR As Long, Ws1LC As Long
Dim c As Range, ColRng As Range
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set Wb1 = Workbooks.Open("C:\_Excel\CompareSheets\Book1.xls") 'Target file (gets the red)
Set Wb2 = Workbooks.Open("C:\_Excel\CompareSheets\Book3.xls") 'Master file
Set Ws1 = Wb1.Worksheets(1)
Set Ws2 = Wb2.Worksheets(1)
Ws1LR = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
Ws1LC = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Set ColRng = Ws1.Range("A1", Ws1.Cells(Ws1LR, Ws1LC))

For Each c In ColRng
    celladdress = c.Address
    If c <> Ws2.Range(celladdress) Then
        c.Interior.ColorIndex = 3
    Else
        c.Interior.ColorIndex = 0
    End If
Next c
For Each c In ColRng
    celladdress = c.Address
    If c.Interior.ColorIndex = 3 Then
        c.EntireRow.Delete
    End If
Next c
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Shums Faruk

Wayne,

I am wondering, why you want to highlight cells then delete, directly you can delete:

Sub CompareTwoSheets()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Ws1LR As Long, Ws1LC As Long
Dim c As Range, DelRng As Range
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set Wb1 = Workbooks.Open("C:\_Excel\CompareSheets\Book1.xls") 'Target file (gets deleted)
Set Wb2 = Workbooks.Open("C:\_Excel\CompareSheets\Book3.xls") 'Master file
Set Ws1 = Wb1.Worksheets(1)
Set Ws2 = Wb2.Worksheets(1)
Ws1LR = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
Ws1LC = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Set ColRng = Ws1.Range("A1", Ws1.Cells(Ws1LR, Ws1LC))

For Each c In DelRng
    celladdress = c.Address
    If c <> Ws2.Range(celladdress) Then
        c.EntireRow.Delete
    End If
Next c
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

RWayneH

ASKER

Hey Shums, I bet this question looks familiar. Felt it to be a separate question...

Other than chg'ing the ColorIndex in the second For/Next to = 0 it is working fine. However I was thinking that rather than going through it twice to keep it in the original For/Next by checking after a set counter? Being however many columns are in the width of Ws1LC. So after the number of columns in Ws1LC are ran, then check that current row, if any exist? leave it, if not, delete it. A For Counter inside a For Next?

This way it only goes past the data once, instead of twice? Thoughts?

Shums Faruk

OK Try below:

Sub CompareTwoSheets()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Ws1LR As Long, Ws1LC As Long
Dim c As Range, ColRng As Range
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set Wb1 = Workbooks.Open("C:\_Excel\CompareSheets\Book1.xls") 'Target file (gets the red)
Set Wb2 = Workbooks.Open("C:\_Excel\CompareSheets\Book3.xls") 'Master file
Set Ws1 = Wb1.Worksheets(1)
Set Ws2 = Wb2.Worksheets(1)
Ws1LR = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
Ws1LC = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Set ColRng = Ws1.Range("A1", Ws1.Cells(Ws1LR, Ws1LC))

For Each c In ColRng
    celladdress = c.Address
    If c <> Ws2.Range(celladdress) Then
        c.Interior.ColorIndex = 3
    Else
        c.EntireRow.Delete
    End If
Next c
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

RWayneH

ASKER

Ok. I may have typed this wrg in my original post to this question??? But I want to keep the rows that have red. And leave the red in the mismatched cell. I tried the second code and it does not like the DelRng, plus it does not show the mismatches because they are gone.

Would like to prevent the deleting of the header row, but that should be fine and no mismatches will be present there.
Hope this makes better sense.

From the original question post: "If there are no cells in this row that got highlighted red. Delete the entire row, shifting them up."

RWayneH

ASKER

The first suggested code works perfectly, except it deletes the row with red highlighted backgrounds instead in keeps them.

The goal is to fix the mismatches in SAP so they eventually match and there are no cell that get the red highlighted background.

ASKER CERTIFIED SOLUTION

Shums Faruk

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

RWayneH

ASKER

Yes it does, and thanks!! I can go back and add the header back in... unless you can make the check start at row 2 instead of one. I figured that the headers where going to get hosed..

Shums Faruk

Just change this line:

Set ColRng = Ws1.Range("A1", Ws1.Cells(Ws1LR, Ws1LC))

Open in new window

To:

Set ColRng = Ws1.Range("A2", Ws1.Cells(Ws1LR, Ws1LC))

Open in new window

RWayneH

ASKER

Excellent!!! as usual. Thanks for the help today.

Shums Faruk

Pleased to help as usual 😊