I tought I had this one figured out, but I was wrong. I want column D to highlight if it doesn't have a match in column C, but I need them to be in the same category in column A.
Column A is a dropdown with the folowing to chose from:
(EL), (Kallvatten, Varmvatten, Värme, IMD), (Fjärrvärme, Fjärrkyla, Hetgas), (IMD Exempel)
I put brackets around the groups. So column D need to have a match in column C and they need to be in the same group(column A).
This is my code right now, it works fine exept from the groups.
Dim rng1 As Range, rng2 As Range, x As Long, j As Long, bFault1 As Boolean
bFault1 = False
For x = 8 To Sheets("Mätplan").Range("D" & Rows.Count).End(xlUp).Row
Set rng1 = Sheets("Mätplan").Range("D" & x)
For j = 8 To Sheets("Mätplan").Range("C" & Rows.Count).End(xlUp).Row
Set rng2 = Sheets("Mätplan").Range("C" & j)
If (StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0) Or IsEmpty(rng1) Then
rng1.Interior.ColorIndex = xlNone
Set rng2 = Nothing
Exit For
ElseIf (j = Sheets("Mätplan").Range("C" & Rows.Count).End(xlUp).Row) Then
rng1.Interior.Color = RGB(255, 204, 204)
bFault1 = True
End If
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next x
Thanks in advance!
CodePudding user response:
Add a check on group inside the second loop.
Sub macro1()
Dim rng1 As Range, rng2 As Range, x As Long, j As Long
Dim bMatch As Boolean, ws As Worksheet
Dim Grp As String
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "EL", 1
.Add "Kallvatten", 2
.Add "Varmvatten", 2
.Add "Värme", 2
.Add "IMD", 2
.Add "Fjärrvärme", 3
.Add "Fjärrkyla", 3
.Add "Hetgas", 3
.Add "IMD", 4
.Add "Exempel", 4
End With
Set ws = Sheets("Mätplan")
For x = 8 To ws.Range("D" & Rows.Count).End(xlUp).Row
bMatch = False
Grp = dict(Trim(ws.Range("A" & x)))
Set rng1 = ws.Range("D" & x)
For j = 8 To ws.Range("C" & Rows.Count).End(xlUp).Row
' match groups
If Grp = dict(Trim(ws.Range("A" & j))) Then
Set rng2 = ws.Range("C" & j)
If (StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0) Or IsEmpty(rng1) Then
bMatch = True
Exit For
End If
End If
Next j
If bMatch Then
rng1.Interior.ColorIndex = xlNone
Else
rng1.Interior.Color = RGB(255, 204, 204)
End If
Next x
End Sub