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

[adtc]

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.

 

[Weaver]

Obviously you're not going to delete rows with condtional formatting, but it's possible to do the deletions in vb

Sub delrows()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    'change the 2 to whatever row your data starts in
    For i = 2 To lr
        'in the following line of code, your 4 columns
        'to compare are represented by the second digit
        'in each set of brackets - change as necessary
        If Cells(i, 1) = Cells(i, 2) And Cells(i, 3) = Cells(i, 4) Then
            Rows(i).EntireRow.Delete
        End If
    Next i
End Sub

 

[adtc]

Hi Weaver, 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 your help!
adtc.

 

[Weaver]

I don't know as I would.

I'm not a big fan of premature exits from for loops in the first place, so maybe I'd rewrite the whole thing from scratch anyway.

It might be useful for you to describe what it is you're trying to achieve in words so we can begin from first principles.

 

[adtc]

Hi weaver,

I'm trying to get the macro to:
1) compare a each cell in column A on sheet1 against each cell on column A in sheet2. If a duplicate is found, highlight (in Red) the entire row on sheet1, and highlight only the cell in sheet2.
2) compare a each cell in column B on sheet1 against each cell on column B in sheet2. If a duplicate is found, draw a border around just that cell on sheet1, and highlight (in Green) just the cell in sheet2.
3) Finally, when both are true on the same row (so on sheet1, the entire row is highlighted and the cell has a border on the same row), delete the entire row.

I have a list of orders that have each have two reference numbers.
I If only one reference number, for a given order, is a duplicate with archived data, then I need to either highlight it or draw a border around it (depending with reference number it is).
But is both reference numbers, for and given order, are duplicates with archived data, then I want to delete it that order (entire row) from sheet1 (which is where the new orders come in each day so we can compare them with the archived data).

I hope this helps explain what I'm trying to accomplish.
Please let me know if I can provide a mock workbook or screen-shots in needed.

Thanks again for your time and effort
ADTC.

 

[Weaver]

I've got a few ideas, so I'll take a look later on when I have more time, if nobody else has come up with a solution.

If you can post a mock workbook (with no vb) on a filesharing site, that would be useful)

 

[adtc]

Thanks a lot Weaver!

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 as you requested
http://dl.dropbox.com/u/8139608/NO-VBmockmock.xls

Thanks for all your hard work.
I look forward to seeing what you come-up with!

 

[Weaver]

Try the following - it seemed to work on your mock data ok

Sub Duplicates2()
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim rng5 As Range, rng6 As Range, rng0 As Range
    Dim c As Range, f As Range, fa As String
    Dim arc_lr As Long, ag_lr As Long
    arc_lr = Worksheets("Archive").Cells(Rows.Count, "A").End(xlUp).Row
    ag_lr = Worksheets("Agents").Cells(Rows.Count, "E").End(xlUp).Row
    Set rng0 = Worksheets("Agents").Range("A:N")
    Set rng1 = Worksheets("Archive").Range("$B1:$B" & arc_lr)
    Set rng2 = Worksheets("Agents").Range("J26:J" & ag_lr)
    Set rng3 = Worksheets("Archive").Range("$A1:$A" & arc_lr)
    Set rng4 = Worksheets("Agents").Range("E26:E" & ag_lr)
    Application.ScreenUpdating = False
    For Each c In rng1.Cells
        v = c.Value
        Set f = rng2.Find(what:=v, Lookat:=xlWhole)
        If Not f Is Nothing Then
            fa = f.Address
            Do
                c.Interior.ColorIndex = 4
                c.Interior.Pattern = xlSolid
                If rng5 Is Nothing Then
                    Set rng5 = f
                Else
                    Set rng5 = Union(rng5, f)
                End If
                Set f = rng2.FindNext(f)
            Loop Until f.Address = fa
        End If
    Next c
    With rng5
        .Interior.ColorIndex = 4
        .Interior.Pattern = xlSolid
        Intersect(.EntireRow, rng0).Interior.ColorIndex = 4
    End With
    For Each c In rng3.Cells
        v = c.Value
        Set f = rng4.Find(what:=v, Lookat:=xlWhole)
        If Not f Is Nothing Then
            fa = f.Address
            Do
                c.Interior.ColorIndex = 5
                c.Interior.Pattern = xlSolid
                If rng6 Is Nothing Then
                    Set rng6 = f
                Else
                    Set rng6 = Union(rng6, f)
                End If
                Set f = rng4.FindNext(f)
            Loop Until f.Address = fa
        End If
    Next c
    With rng6
        .Interior.ColorIndex = 5
        .Borders.Weight = xlThick
    End With
    On Error Resume Next
    Intersect(rng5.EntireRow, rng6.EntireRow).Delete
End Sub

 

[adtc]

sorry for the late response.

Works perfectly!, thank's for putting in all the hard work, my boss was very pleased!

 

[Weaver]

It wasn't too hard - it was very close to something I was working on already, what with building up the ranges before adding the formatting in one go. The final bit was spotting that if you overlapped (what intersect() does) the 2 ranges then what was left would be the deletions. I used find, rather than looping through all the cells as this is usually quicker on large datasets with few potential matches and just looks tidier and if you figure out where your data ends before you start, you only have to go through the cells you know have data, which saves having to exit the loops.