VBA Conditional formatting to delete entire row when two variable are ture

**adtc** · 08-13-2011, 05:39 AM

Hi all,

In my on-going work project (that i thought was finished ><) I have code that basically does this:

IF cell1 = cell2 THEN highlight entire row Blue.
IF cell3 = cell4 THEN highlight entire row Red.

This obviously cause problems when both are true as the as the you can't see both colours.

Is it possible to have something to the effect of:

IF cell1=cell2 AND cell3=cell4 THEN delete entire row.

I have tried a few variations that sound intuitive, but I cant seem to get the code syntax right.

Thanks for any help you can give me, much appreciated!

ADTC.

**SOS** · 08-13-2011, 07:27 AM

Hi ADTC,

You could try this code

Sub Foo()
    If Range("A1").Value = Range("B1").Value Then
        With Rows("1:1").Interior
            .ColorIndex = 33
            .Pattern = xlSolid
        End With
    Else
    End If
    If Range("C1").Value = Range("D1").Value Then
        With Rows("1:1").Interior
            .ColorIndex = 3
            .Pattern = xlSolid
        End With
    Else
    End If
    If Range("A1").Value = Range("B1").Value And Range("C1").Value = Range("D1").Value Then
        Rows("1:1").Delete
    End If
End Sub

**adtc** · 08-13-2011, 09:16 PM

Hi SOS, thanks for the response. I'm still having a little trouble getting it to compile - errors all over the place due to my existing code.

How would I incorporate your code in to mine:

Sub Duplicates()
Dim rng1, rng2, rng3, rng4, cell1, cell2, cell3, cell4, As Range
            
             Set rng1 = Worksheets("Archive").Range("$B:$B")
             Set rng2 = Worksheets("Agents").Range("J26:J1000")
             Set rng3 = Worksheets("Archive").Range("$A:$A") 
             Set rng4 = Worksheets("Agents").Range("E26:E1000")

For Each cell1 In rng1
     If IsEmpty(cell1.Value) Then Exit For

For Each cell2 In rng2
      If IsEmpty(cell2.Value) Then Exit For

If cell1.Value = cell2.Value Then
       cell1.Interior.ColorIndex = 4
       cell1.Interior.Pattern = xlSolid
       cell2.Interior.ColorIndex = 4
       cell2.Interior.Pattern = xlSolid
       cell2.EntireRow.Resize(, 14).Interior.ColorIndex = 4
End If

Next cell2
Next cell1

For Each cell3 In rng3
     If IsEmpty(cell3.Value) Then Exit For

For Each cell4 In rng4
       If IsEmpty(cell4.Value) Then Exit For

If cell3.Value = cell4.Value Then
       cell3.Interior.ColorIndex = 5
       cell3.Interior.Pattern = xlSolid
       cell2.Font.ColorIndex = 5
       cell4.Borders.Weight = xlThick

End Sub

Thanks again for all your help!

**adtc** · 08-15-2011, 04:23 AM

Hi SOS,

Thanks for working out the re-wite for me. I have just given it a go but it doen't quite work.
The formatting works perfectly, it's just the loop for deleting the rows where [cel1= cell2 AND cell3=cell4].

At present, it looks like it is only deleting the very first row, from the bottom, where cell1=cell2 which it should not delete as it does not satisfy the criteria for deletion: [cel1= cell2 AND cell3=cell4].
After it deleted that first row, the loop/macro stops.

Hope this helps .
And thanks again for going to the trouble of helping my get this working.
I can send you a mock workbook if you need.

ADTC.

**adtc** · 08-15-2011, 10:09 AM

I've uploaded to mock workbooks.

One with VB code already in (for reference if needed)
http://dl.dropbox.com/u/8139608/VBmock.xls
And a second with No VB code if you like a clean slate, but need to see how it should look.
http://dl.dropbox.com/u/8139608/NO-VBmockmock.xls

Hope this helps
Thanks for all your hard work.
I look forward to seeing what you come-up with if you have some free time

ADTC

**SOS** · 08-15-2011, 04:43 PM

Hi adtc,

Try this code. I've added a loop at the end of the Sub which loops backwards from the bottom most cell in Col J and checks its interior colour, then check the interior of the corresponding cell in Col E and if both conditions are met then it deletes the row.

You should also declare each variable as a range.

Give it a shot and post back please

Sub Duplicates()
' code to find duplicates in 2 different worksheets
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim cell1 As Range, cell2 As Range, cell3 As Range, cell4 As Range
Dim i As Long, lastCell2Row As Long

Set rng1 = Worksheets("Archive").Range("$B:$B")
Set rng2 = Worksheets("Agents").Range("J26:J1000")
Set rng3 = Worksheets("Archive").Range("$A:$A")
Set rng4 = Worksheets("Agents").Range("E26:E1000")
    For Each cell1 In rng1
        If IsEmpty(cell1.Value) Then Exit For
        'check for empty rows. If true then exit the program
            For Each cell2 In rng2
                If IsEmpty(cell2.Value) Then Exit For
                    If cell1.Value = cell2.Value Then
                    'compare data in cell1 and cell2 and then format if they have equal values.
                        cell1.Interior.ColorIndex = 4
                        cell1.Interior.Pattern = xlSolid
                        cell1.Borders.Weight = xlThick
                        cell2.Interior.ColorIndex = 4
                        cell2.Interior.Pattern = xlSolid
                        cell2.EntireRow.Resize(, 14).Interior.ColorIndex = 4
                    End If
            Next cell2
    Next cell1

    For Each cell3 In rng3
        If IsEmpty(cell3.Value) Then Exit For
        'check for empty rows. If true then exit the program
            For Each cell4 In rng4
                If IsEmpty(cell4.Value) Then Exit For
                    If cell3.Value = cell4.Value Then
                    'compare data in cell1 and cell2 and then format if they have equal values.
                        cell3.Interior.ColorIndex = 41
                        cell3.Borders.Weight = xlThick
                        cell3.Interior.Pattern = xlSolid
                        cell4.Interior.ColorIndex = 41
                        cell4.Borders.Weight = xlThick
                    End If
            Next cell4
    Next cell3

'get the last row in Col J with data in it
lastCell2Row = Worksheets("Agents").Range("J65536").End(xlUp).Row

'loop backwards and if the 2 conditions are met
'then delete the row
For i = lastCell2Row To 26 Step -1
    If Cells(i, "J").Interior.ColorIndex = 4 Then
        If Cells(i, "E").Interior.ColorIndex = 41 Then
            Rows(i & ":" & i).Delete
        End If
    End If
Next i
End Sub

**adtc** · 08-13-2011, 09:35 PM

Originally Posted by Mordred

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

my apologies, thanks for the reminder.

thanks again in advance to anyone that can help me with this coding.

**SOS** · 08-14-2011, 02:41 PM

Hi

I've edited the code by adding a variable (x) which increments each loop to determine which row to delete.

Please let me know how it goes

Sub Duplicates()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim cell1 As Range, cell2 As Range, cell3 As Range, cell4 As Range
Dim x As Long
            
             Set rng1 = Worksheets("Archive").Range("$B:$B")
             Set rng2 = Worksheets("Agents").Range("J26:J1000")
             Set rng3 = Worksheets("Archive").Range("$A:$A")
             Set rng4 = Worksheets("Agents").Range("E26:E1000")

For Each cell1 In rng1
x = cell1.Row
     If IsEmpty(cell1.Value) Then Exit For

For Each cell2 In rng2
      If IsEmpty(cell2.Value) Then Exit For

If cell1.Value = cell2.Value Then
       cell1.Interior.ColorIndex = 4
       cell1.Interior.Pattern = xlSolid
       cell2.Interior.ColorIndex = 4
       cell2.Interior.Pattern = xlSolid
       cell2.EntireRow.Resize(, 14).Interior.ColorIndex = 4
End If

Next cell2
Next cell1

For Each cell3 In rng3
     If IsEmpty(cell3.Value) Then Exit For

For Each cell4 In rng4
       If IsEmpty(cell4.Value) Then Exit For

If cell3.Value = cell4.Value Then
       cell3.Interior.ColorIndex = 5
       cell3.Interior.Pattern = xlSolid
       cell4.Font.ColorIndex = 5
       cell4.Borders.Weight = xlThick
       cell4.EntireRow.Resize(, 14).Interior.ColorIndex = 4
End If

Next cell4
Next cell3

x = x - 1
If cell1.Value = cell2.Value And cell3.Value = cell4.Value Then
    Sheets("Archive").Rows(x & ":" & x).Delete
End If
End Sub