Excel 2013 VBA to Highlight Unique Value If Value Found On Any Other Worksheet

[SweetA1217]

Excel 2013 VBA to Highlight Unique Value If Value Found On Any Other Worksheet
Can anyone help me write VBA code to Highlight a Unique Value on a Worksheet (Shop Agenda) if that same unique value is located on another other worksheet in the workbook. Here is the kicker: I cannot hardcode the name of the other worksheets because I have written code to pull multiple workbooks into a single workbook. Therefore, the names of the other worksheets are subject to change.

In Worksheet "Shop Agenda", I want to check if any values in row B (starting at B3 and Range(Selection, Selection.End(xlDown))) is in any other worksheet. If the value is in another worksheet, then highlight that unique value on the "Shop Agenda" worksheet.

I have found code to look at another worksheet for which the worksheet name is known and hardcoded. In this case, the worksheet name will not be known until the worksheet is pulled into the workbook.

Here is the code that I am playing with:

Sub HighlightPriority()
Dim ws As Worksheet
Dim ShopTable As Range
Dim PriorityTable As Range
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim lastRow As Long
Dim cell As Range
Dim Imp_Row As Integer
Dim Imp_Col As Integer

Worksheets("Shop Agenda").Activate
Set ShopTable = Range("B3", Range("B3").End(xlDown))

For Each ws In ThisWorkbook.Worksheets
sSheetName = ActiveSheet.Name
Set PriorityTable = ActiveSheet.Columns("A:Q") '<=== "A:Q" is placeholder, do not know what columns will be on other worksheet

With Worksheets(sSheetName)
lastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row

For Each cell In ShopTable
PriorityTable.Cells(Imp_Row, Imp_Col) = Application.WorksheetFunction.VLookup(cell, PriorityTable, 1, False) '<=== Cannot use VLookup b/c will not know where unique value is located
Imp_Row = Imp_Row + 1
If cell.Value = Cells(Imp_Row, Imp_Col) Then
cell.EntireRow.Interior.ColorIndex = 39
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next cell

End With

Next ws

 

[SweetA1217]

They are all hard values. Attached are 2 different images. This is using the same data set with the same code (adjusted accordingly for B3 and I3) looking at the same tabs. The "fail" data set doesn't look in the "114" tab, but the other data set does.

 

[Fluff]

In the 2nd image image the values in col B of the 114 sheet are aligned left, which suggests that they are text & not numbers.
What happens if you change the format to numbers showing 2 decimal places?

 

[SweetA1217]

In the 2nd image image the values in col B of the 114 sheet are aligned left, which suggests that they are text & not numbers.
What happens if you change the format to numbers showing 2 decimal places?

I checked this and just ran it again this way. No change. Note that the values in col B of the 114 sheet are aligned left for the data set that works also.

 

[SweetA1217]

Would it be possible for you to annotate the code for what each step does? This may help me through the debugging process.
When steeping through the If Dic.Exists(Ary(r, c)) statement, the compare is skipping to End If. This is telling me that the comparison is failing. Is there a way to see what the two items are that are being compared?

 

[Fluff]

Is there a way to see what the two items are that are being compared?

Nope, you can see what value is in the array by hovering the mouse over Ary(r, c)but it's comparing that to the entire dictionary.
Is this in answer to my question in post#12?

No change.

If so it means they are text & not numbers.

 

[SweetA1217]

Nope, you can see what value is in the array by hovering the mouse over Ary(r, c)but it's comparing that to the entire dictionary.
Is this in answer to my question in post#12?

If so it means they are text & not numbers.

To clarify my response to post #12, I changed the format for both the input data and the read data to reflect real numbers with 2 decimal points. I ran the code again, and the matching numbers still did not agree with the "If Dic.Exists(Ary(r, c)) Then" statement; therefore, it skipped without highlighting.

 

[Fluff]

I changed the format for both the input data and the read data to reflect real numbers with 2 decimal points.

But did it actually display 2 decimals for each & every value in both sheets?

 

[SweetA1217]

But did it actually display 2 decimals for each & every value in both sheets?

My apologies for the delayed response. It did not convert everything to 2 decimals. Thank you for finding this issue.

Being that it was pulling in some of the data from other sheets, but not all sheets, that tells me that I have a variety of formatting across all the sheets.
Is there a way to modify the code you provided to do the initial sweep with the current formatting (text) in Shop Agenda column B (data starting at B3), then do a second sweep of the data and sheets after converting the Shop Agenda Column B data to number formatting? I am assuming that the CDec(String) function would need to be utilized.

 

[SweetA1217]

I am playing with this. Perform initial sweep, then run loop again with using C1.Value = CDec(C1.Value) to convert C1 value to decimal before adding to dictionary.

Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = 1
With Sheets("Shop Agenda")
For Each Cl In .Range("B3", .Range("B" & Rows.Count).End(xlUp))
Set Dic(Cl.Value) = Cl
Next Cl
End With
For Each Ws In Worksheets
If Not Ws.Name = "Shop Agenda" Then
Ary = Ws.UsedRange.Value2
If Not IsEmpty(Ary) Then
For r = 1 To UBound(Ary)
For c = 1 To UBound(Ary, 2)
If Dic.Exists(Ary(r, c)) Then
Dic(Ary(r, c)).Interior.ColorIndex = 27
Dic.Remove Ary(r, c)
End If
Next c
Next r
End If
End If
Next Ws


Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = 1
With Sheets("Shop Agenda")
For Each Cl In .Range("B3", .Range("B" & Rows.Count).End(xlUp))
C1.Value = CDec(C1.Value)  'Convert to decimal
Set Dic(Cl.Value) = Cl
Next Cl
End With
For Each Ws In Worksheets
If Not Ws.Name = "Shop Agenda" Then
Ary = Ws.UsedRange.Value2
If Not IsEmpty(Ary) Then
For r = 1 To UBound(Ary)
For c = 1 To UBound(Ary, 2)
If Dic.Exists(Ary(r, c)) Then
Dic(Ary(r, c)).Interior.ColorIndex = 27
Dic.Remove Ary(r, c)
End If
Next c
Next r
End If
End If
Next Ws

 

[Fluff]

Try

Sub SweetA()
   Dim Ary As Variant
   Dim r As Long, c As Long
   Dim Cl As Range
   Dim WS As Worksheet
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   With Sheets("Shop Agenda")
      For Each Cl In .Range("B3", .Range("B" & Rows.Count).End(xlUp))
         Set Dic(Cl.Value & "") = Cl
      Next Cl
   End With
   For Each WS In Worksheets
      If Not WS.Name = "Shop Agenda" Then
         Ary = WS.UsedRange.Value2
         If Not IsEmpty(Ary) Then
            For r = 1 To UBound(Ary)
               For c = 1 To UBound(Ary, 2)
                  If Dic.Exists(Ary(r, c) & "") Then
                     Dic(Ary(r, c) & "").Interior.ColorIndex = 39
                     Dic.Remove Ary(r, c) & ""
                  End If
               Next c
            Next r
         End If
      End If
   Next WS
End Sub