P
phmckeever
I need the data in column E to be highlighted when
rows begin with 'ign' and 'leg' in column A and have identical ID code
in column B.
Here is a 'cut and paste' from the worksheet (The XXX is just placeholders
to demonstrate).
A B C D E
1 ign ABGN XXX XXX VA
2 leg ABGN XXX XXX *
3 ign ABVL XXX XXX KS
4 leg ABVL XXX XXX *
5 leg ADA XXX XXX *
6 ign ADAM XXX XXX OH
7 leg ADAM XXX XXX *
8 ign ADAR XXX XXX OH
9 leg ADAR XXX XXX *
10 ign AHSK XXX XXX NC
11 leg AHSK XXX XXX *
12 ign ALDN XXX XXX KS
13 leg ALDN XXX XXX *
The code below is highlighting cells e1 and e2, e3 and e4,
which is correct because columns A and B meet the criteria.
And cell e5 is not highlighted, which is also correct because it does not
meet the criteria.
However, the highlight is not being picked up at cells e6 and e7, e8 and e9,
e10 and e11, and e12
and e13, which it should because Column A and B fit the criteria for a
match, ign and leg and identical id code.
Can you please, pleasssssse help me with this code. Thank you in advance.
phmckeever
Range("A1").Select
Set Record1 = Range("$b2")
Set Record2 = Range("$b3")
Range("A1").Select
Do While (Record1 <> "")
If (Record1 = Record2) Then
IngRow = Record1.Row
strRow1 = Trim$(Str$(IngRow))
strRow2 = Trim$(Str$(IngRow + 1))
s = "=AND($A" & strRow1 & "=""ign"", " & _
"$A" & strRow2 & "=""leg""," & _
"$B" & strRow1 & "=$B" & strRow2 & ")"
if evaluate(s) = true then
Set rngAll = Range("$C" & strRow1 & ":$E" & strRow2)
rngAll.FormatConditions.Delete
For x = 1 To rngAll.Columns.Count
strFormula = "=AND($A" & strRow1 & "=""ign"", " & _
"$A" & strRow2 & "=""leg""," & _
"$B" & strRow1 & "=$B" & strRow2 & "," & _
rngAll.Cells(1, x).Address & "<>" & _
rngAll.Cells(2, x).Address & ")"
rngAll.Cells(1, x).Select
Selection.FormatConditions.Add _
Type:=xlExpression, Formula1:=strFormula
Selection.FormatConditions(1).Interior.ColorIndex = 6
rngAll.Cells(2, x).Select
Selection.FormatConditions.Add _
Type:=xlExpression, Formula1:=strFormula
Selection.FormatConditions(1).Interior.ColorIndex = 6
Next x
End if
End If
Set Record1 = Record1.Offset(2, 0)
Set Record2 = Record2.Offset(2, 0)
Loop
rows begin with 'ign' and 'leg' in column A and have identical ID code
in column B.
Here is a 'cut and paste' from the worksheet (The XXX is just placeholders
to demonstrate).
A B C D E
1 ign ABGN XXX XXX VA
2 leg ABGN XXX XXX *
3 ign ABVL XXX XXX KS
4 leg ABVL XXX XXX *
5 leg ADA XXX XXX *
6 ign ADAM XXX XXX OH
7 leg ADAM XXX XXX *
8 ign ADAR XXX XXX OH
9 leg ADAR XXX XXX *
10 ign AHSK XXX XXX NC
11 leg AHSK XXX XXX *
12 ign ALDN XXX XXX KS
13 leg ALDN XXX XXX *
The code below is highlighting cells e1 and e2, e3 and e4,
which is correct because columns A and B meet the criteria.
And cell e5 is not highlighted, which is also correct because it does not
meet the criteria.
However, the highlight is not being picked up at cells e6 and e7, e8 and e9,
e10 and e11, and e12
and e13, which it should because Column A and B fit the criteria for a
match, ign and leg and identical id code.
Can you please, pleasssssse help me with this code. Thank you in advance.
phmckeever
Range("A1").Select
Set Record1 = Range("$b2")
Set Record2 = Range("$b3")
Range("A1").Select
Do While (Record1 <> "")
If (Record1 = Record2) Then
IngRow = Record1.Row
strRow1 = Trim$(Str$(IngRow))
strRow2 = Trim$(Str$(IngRow + 1))
s = "=AND($A" & strRow1 & "=""ign"", " & _
"$A" & strRow2 & "=""leg""," & _
"$B" & strRow1 & "=$B" & strRow2 & ")"
if evaluate(s) = true then
Set rngAll = Range("$C" & strRow1 & ":$E" & strRow2)
rngAll.FormatConditions.Delete
For x = 1 To rngAll.Columns.Count
strFormula = "=AND($A" & strRow1 & "=""ign"", " & _
"$A" & strRow2 & "=""leg""," & _
"$B" & strRow1 & "=$B" & strRow2 & "," & _
rngAll.Cells(1, x).Address & "<>" & _
rngAll.Cells(2, x).Address & ")"
rngAll.Cells(1, x).Select
Selection.FormatConditions.Add _
Type:=xlExpression, Formula1:=strFormula
Selection.FormatConditions(1).Interior.ColorIndex = 6
rngAll.Cells(2, x).Select
Selection.FormatConditions.Add _
Type:=xlExpression, Formula1:=strFormula
Selection.FormatConditions(1).Interior.ColorIndex = 6
Next x
End if
End If
Set Record1 = Record1.Offset(2, 0)
Set Record2 = Record2.Offset(2, 0)
Loop