Gos-C
Active Member
- Joined
- Apr 11, 2005
- Messages
- 258
- Office Version
- 365
- 2016
- Platform
- Windows
Hi all,
I need the following code to highlight A:EF if the row has the value 4000 or 4500 in column J. It does that.
The function checks if a corresponding record, which indicate void, is found - F, G and CE will be the same as the original record. If one is found, I want the code to highlight A:EF of the original record.
I need some help to fix the red portion of the code, please. I can't figure out how to code it.
Thank you,
Gos-C
I need the following code to highlight A:EF if the row has the value 4000 or 4500 in column J. It does that.
The function checks if a corresponding record, which indicate void, is found - F, G and CE will be the same as the original record. If one is found, I want the code to highlight A:EF of the original record.
I need some help to fix the red portion of the code, please. I can't figure out how to code it.
Code:
Sub Highlight_Exclusions()
Dim oLastRow As Long
Dim c As Range, hRng As Range, n As Long
' Const CC As Integer = 3 * 26 + 3 'column 'CC' as a number
Const A As Integer = 1 'column 'G' as a number
' Const EC As Integer = 5 * 26 + 3 'column 'EC' as a number
Const EF As Integer = 5 * 26 + 6 'column 'EF' as a number
Const J As Integer = 10 'column 'J' as a number
Application.ScreenUpdating = False
oLastRow = Cells.SpecialCells(xlLastCell).Row 'report original lastrow
For n = 2 To oLastRow
Set c = ActiveSheet.Cells(n, J) 'set range to row n, column J
Set hRng = ActiveSheet.Range(Cells(n, A), Cells(n, EF)) 'set range to row n, column G
If c.Value = 4000 Or c.Value = 4500 Then '4000 & 4500 claim
hRng.Interior.ColorIndex = 36
[COLOR="#FF0000"][B]For Each hRng In ActiveSheet
If CheckF_G_CE(Range("F" & Target.Row), Range("G" & Target.Row), _
Range("CE" & Target.Row), Target.Row) Then
hRng.Interior.ColorIndex = 36
End If
Next n
End If
Next hRng
[/B][/COLOR]
Application.ScreenUpdating = True
End Sub
Public Function CheckF_G_CE(Fstr As String, Gstr As String, _
CEstr As String, Rw As Long) As Boolean
Dim vFIND As Range
On Error Resume Next
Set vFIND = Range("F:F").Find(Fstr, After:=Range("F" & Rw), LookIn:=xlValues, LookAt:=xlWhole)
If Not vFIND Is Nothing Then
Do Until vFIND.Row = Rw
If Range("G" & vFIND.Row) = Gstr And _
Range("CE" & vFIND.Row) = CEstr Then ' And _
CheckF_G_CE = True
Exit Function
End If
Set vFIND = Range("F:F").FindNext(vFIND)
Loop
End If
' by default if we reach this point, the result is FALSE, no duplicates found
End Function
Thank you,
Gos-C