Code To Highlight Rows When Data Is Missing In Column AA

Dazzawm

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,783
Office Version
  1. 365
Platform
  1. Windows
Hi. I need a code please that when it is run a matching set of cells are highlighted when there is data missing amongst group of rows. Below should explain better.

Column C Column AA
AUA618 2012Please Obtain OE Number And Cross Refer
AUA618 2012Please Obtain OE Number And Cross Refer
AUA618 2012Please Obtain OE Number And Cross Refer
AUA618 3012
AUA618 3012
AUA618 3012
AUA620 2008Please Obtain OE Number And Cross Refer
AUA620 2008Please Obtain OE Number And Cross Refer
AUA620 2008
AUA620 2017Please Obtain OE Number And Cross Refer
AUA620 2017
AUA620 2017
AUA620 3008Please Obtain OE Number And Cross Refer
AUA620 3008Please Obtain OE Number And Cross Refer
AUA620 3008
AUA620 3014
AUA620 3014Please Obtain OE Number And Cross Refer
AUA620 3014
AUA620D 2001Please Obtain OE Number And Cross Refer
AUA620D 2001Please Obtain OE Number And Cross Refer
AUA620D 2001Please Obtain OE Number And Cross Refer

As you can see sets of rows match in column C, if there is data missing in column AA then the rows need to be highlighted like below. You'll notice data is missing in most rows as 'Please Obtain OE Number And Cross Refer' is missing in most. The bottom set of 3 remain unhighlighted as data is in all three rows in Column AA. Thanks

Coulmn C Column AA
1681746649328.png
 
Sort by date Sort by votes
DanteAmor said:
Ok, for the same group, if all the cells of the AA are the same, then ignore, otherwise highlight.
Try this. The same technique with dictionary and arrays so that the process is very fast.
VBA Code: 
Sub HighlightRows()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean, txt As String
  Dim rng As Range, rng1 As Range, rng2 As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
   
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
 
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      dic(a(i, 1)) = y & "|" & 1 & "|" & a(i, 25) & "|" & False
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      txt = Split(dic(a(i, 1)), "|")(2)
      bln = Split(dic(a(i, 1)), "|")(3)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) <> txt Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & txt & "|" & bln
    End If
  Next
 
  Set rng1 = Range("C1,AA1")
  Set rng2 = Range("C1,AA1")
 
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    txt = Split(dic(ky), "|")(2)
    bln = Split(dic(ky), "|")(3)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        Set rng = Range("C" & m & ",AA" & m)
        If k = 0 Then Set rng1 = Union(rng1, rng) Else Set rng2 = Union(rng2, rng)
      Next
    End If
  Next
 
  Range("C:C, AA:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = 16750899
  Range("C1,AA1").Interior.ColorIndex = xlNone
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------
Click to expand...
Seems to work well, thanks. Would it be possible to colour the entire row from A to AA please? Rather than just columns C and AA?
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Micron said:
Beat me by 16 minutes but will post anyway.
VBA Code: 
Sub ConditionalFormat()
Dim ws As Worksheet
Dim rng1 As Range, rng2 As Range
Dim Lrow As Long, i As Integer, x As Integer
Dim str1 As String, str2 As String
Dim bolEqual As Boolean
 
Set ws = ActiveSheet
Lrow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
For i = 1 To Lrow
    str1 = ws.Range("C" & i)
    str2 = ws.Range("AA" & i)
    Set rng1 = ws.Range("C" & i)
    Set rng2 = ws.Cells.Find(str1, rng1, xlFormulas, xlWhole, xlByRows, xlPrevious, False)
        For x = rng1.Row To rng2.Row
            If ws.Range("AA" & x) = str2 Then
               bolEqual = True
            Else
               bolEqual = False
            End If
            i = i + 1
        Next
        i = i - 1
   If Not bolEqual Then ws.Range("C" & rng1.Row & ":" & "AA" & rng2.Row).Interior.Color = vbYellow
  Next
 
End Sub
Click to expand...
Thanks but it doesn't seem to work on all groups of rows, also a lot slower than @DanteAmor code.


Thanks to you both for your time and efforts.
 
Upvote 0
Dazzawm said:
Seems to work well, thanks. Would it be possible to colour the entire row from A to AA please? Rather than just columns C and AA?
Click to expand...
Try this:

VBA Code: 
Sub HighlightRows()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean, txt As String
  Dim rng As Range, rng1 As Range, rng2 As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
    
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      dic(a(i, 1)) = y & "|" & 1 & "|" & a(i, 25) & "|" & False
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      txt = Split(dic(a(i, 1)), "|")(2)
      bln = Split(dic(a(i, 1)), "|")(3)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) <> txt Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & txt & "|" & bln
    End If
  Next
  
  Set rng1 = Range("AA1")
  Set rng2 = Range("AA1")
  
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    txt = Split(dic(ky), "|")(2)
    bln = Split(dic(ky), "|")(3)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        Set rng = Range("A" & m & ":AA" & m)
        If k = 0 Then Set rng1 = Union(rng1, rng) Else Set rng2 = Union(rng2, rng)
      Next
    End If
  Next
  
  Range("A:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = 16750899
  Range("AA1").Interior.ColorIndex = xlNone
End Sub


'https://www.mrexcel.com/board/threads/code-to-highlight-rows-when-data-is-missing-in-column-aa.1235137/#post-6048988
      'If bln = False And a(i, 25) = "" Then bln = True

Sub HighlightRows_v1()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean
  Dim rng As Range, rng1 As Range, rng2 As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
    
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      If a(i, 25) = "" Then bln = True Else bln = False
      dic(a(i, 1)) = y & "|" & 1 & "|" & bln
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      bln = Split(dic(a(i, 1)), "|")(2)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) = "" Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & bln
    End If
  Next
  
  Set rng1 = Range("C1,AA1")
  Set rng2 = Range("C1,AA1")
  
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    bln = Split(dic(ky), "|")(2)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        If k = 0 Then
          Set rng1 = Union(rng1, Range("C" & m & ",AA" & m))
        Else
          Set rng2 = Union(rng2, Range("C" & m & ",AA" & m))
        End If
      Next
    End If
  Next
  
  Range("C:C, AA:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = vbBlue
  Range("C1,AA1").Interior.ColorIndex = xlNone
End Sub
 
Upvote 0
DanteAmor said:
Try this:

VBA Code: 
Sub HighlightRows()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean, txt As String
  Dim rng As Range, rng1 As Range, rng2 As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
   
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
 
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      dic(a(i, 1)) = y & "|" & 1 & "|" & a(i, 25) & "|" & False
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      txt = Split(dic(a(i, 1)), "|")(2)
      bln = Split(dic(a(i, 1)), "|")(3)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) <> txt Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & txt & "|" & bln
    End If
  Next
 
  Set rng1 = Range("AA1")
  Set rng2 = Range("AA1")
 
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    txt = Split(dic(ky), "|")(2)
    bln = Split(dic(ky), "|")(3)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        Set rng = Range("A" & m & ":AA" & m)
        If k = 0 Then Set rng1 = Union(rng1, rng) Else Set rng2 = Union(rng2, rng)
      Next
    End If
  Next
 
  Range("A:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = 16750899
  Range("AA1").Interior.ColorIndex = xlNone
End Sub


'https://www.mrexcel.com/board/threads/code-to-highlight-rows-when-data-is-missing-in-column-aa.1235137/#post-6048988
      'If bln = False And a(i, 25) = "" Then bln = True

Sub HighlightRows_v1()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean
  Dim rng As Range, rng1 As Range, rng2 As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
   
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
 
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      If a(i, 25) = "" Then bln = True Else bln = False
      dic(a(i, 1)) = y & "|" & 1 & "|" & bln
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      bln = Split(dic(a(i, 1)), "|")(2)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) = "" Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & bln
    End If
  Next
 
  Set rng1 = Range("C1,AA1")
  Set rng2 = Range("C1,AA1")
 
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    bln = Split(dic(ky), "|")(2)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        If k = 0 Then
          Set rng1 = Union(rng1, Range("C" & m & ",AA" & m))
        Else
          Set rng2 = Union(rng2, Range("C" & m & ",AA" & m))
        End If
      Next
    End If
  Next
 
  Range("C:C, AA:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = vbBlue
  Range("C1,AA1").Interior.ColorIndex = xlNone
End Sub
Click to expand...
This is very odd. I am trying this new code on exactly the same set of data as the first code, but the first code completed in a few secs but this new code is still running after 15mins? If I am costing you too much time please don't worry I can make do with the first code. Thanks.
 
Upvote 0
Maybe it's not the code? How many rows are you running it against?
 
Upvote 0
Micron said:
Maybe it's not the code? How many rows are you running it against?
Click to expand...
It varies on each file, but this one was about 80,000. But like I said the first code worked fine on exactly the same data in a few seconds.
 
Upvote 0
Thanks. After copying/pasting down to row 155K+ I see a problem with mine. rng1 should be the first C cell you'd want to start in, rng2 should be the last C cell that contains the same value. Instead, both are the entire range. It worked fine with your small example but not good with lots of rows. You'll probably get a fix from DanteAmor so I won't bother to try to fix mine.
 
Upvote 0
Micron said:
Thanks. After copying/pasting down to row 155K+ I see a problem with mine. rng1 should be the first C cell you'd want to start in, rng2 should be the last C cell that contains the same value. Instead, both are the entire range. It worked fine with your small example but not good with lots of rows. You'll probably get a fix from DanteAmor so I won't bother to try to fix mine.
Click to expand...
That's fine thanks for your efforts. I don't want @DanteAmor to spend anymore time on it the first code will suffice.
 
Upvote 0
Dazzawm said:
but the first code completed in a few secs but this new code is still running after 15mins? I
Click to expand...

It's very strange, I only enlarged the cells to highlight.

Try again:
Rich (BB code): 
Sub HighlightRows()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean, txt As String
  Dim rng As Range, rng1 As Range, rng2 As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
    
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      dic(a(i, 1)) = y & "|" & 1 & "|" & a(i, 25) & "|" & False
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      txt = Split(dic(a(i, 1)), "|")(2)
      bln = Split(dic(a(i, 1)), "|")(3)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) <> txt Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & txt & "|" & bln
    End If
  Next
  
  Set rng1 = Range("A1:AA1")
  Set rng2 = Range("A1:AA1")
  
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    txt = Split(dic(ky), "|")(2)
    bln = Split(dic(ky), "|")(3)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        Set rng = Range("A" & m & ":AA" & m)
        If k = 0 Then Set rng1 = Union(rng1, rng) Else Set rng2 = Union(rng2, rng)
      Next
    End If
  Next
  
  Range("A:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = 16750899
  Range("A1:AA1").Interior.ColorIndex = xlNone
End Sub
 
Upvote 0
Solution
DanteAmor said:
It's very strange, I only enlarged the cells to highlight.

Try again:
Rich (BB code): 
Sub HighlightRows()      'When Data Is Missing
  Dim i As Long, y As Long, fil As Long, col As Long, j As Long, k As Long, m As Long
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim bln As Boolean, txt As String
  Dim rng As Range, rng1 As Range, rng2 As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
   
  a = Range("C1:AA" & Range("C" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1000)
 
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      y = y + 1
      dic(a(i, 1)) = y & "|" & 1 & "|" & a(i, 25) & "|" & False
      b(y, 1) = i
    Else
      fil = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1)
      txt = Split(dic(a(i, 1)), "|")(2)
      bln = Split(dic(a(i, 1)), "|")(3)
      col = col + 1
      b(fil, col) = i
      If a(i, 25) <> txt Then bln = True
      dic(a(i, 1)) = fil & "|" & col & "|" & txt & "|" & bln
    End If
  Next
 
  Set rng1 = Range("A1:AA1")
  Set rng2 = Range("A1:AA1")
 
  For Each ky In dic.keys
    fil = Split(dic(ky), "|")(0)
    col = Split(dic(ky), "|")(1)
    txt = Split(dic(ky), "|")(2)
    bln = Split(dic(ky), "|")(3)
    If bln = True Then
      If k = 0 Then k = 1 Else k = 0
      For j = 1 To col
        m = b(fil, j)
        Set rng = Range("A" & m & ":AA" & m)
        If k = 0 Then Set rng1 = Union(rng1, rng) Else Set rng2 = Union(rng2, rng)
      Next
    End If
  Next
 
  Range("A:AA").Interior.ColorIndex = xlNone
  rng1.Interior.Color = vbYellow
  rng2.Interior.Color = 16750899
  Range("A1:AA1").Interior.ColorIndex = xlNone
End Sub
Click to expand...
That's a lot quicker, much obliged to you squire.
 
Upvote 1
You must log in or register to reply here.

Similar threads

Dazzawm
  • Question Question
Code To Highlight Row When Data Is In AA
2 3
Replies
23
Views
1K
CSmith
CSmith
ChrisMac1
  • Question Question
VBA - Compare specific data in one column on one sheet, with the same column on 4 other sheets, copy specific cells if match found.
Replies
1
Views
369
ChrisMac1
ChrisMac1
D
  • Solved
How To Reference Last Row With Data In A Column?
Replies
8
Views
402
Dhira
D
J
  • Question Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
336
JMC57
J
C
  • Question Question
Use Row Data to Create New Sheet from Template and Reference Data
Replies
0
Views
630
ChrisMas92
C

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top