Highlight Row if Cell Value Found in List in Other Workbook

[Gos-C]

Hi all,

I am creating a macro to open a .dat file, delete unwanted rows and highlight all rows where the specified cell value is found in a list which is located in a worksheet in the workbook containing the macro.

I cannot get the VLOOKUP to work. It gives the error, "Run-time error '1004': Unable to get the VLOOKUP property of the WorksheetFunction class."

Actually, it highlights two rows only - even though other values are on the list, and then gives the error. Also, it highlights G:U but I need it to highlight A:O.

Here is my code:

Public Sub PrepareReport()

    Dim strReport As String
    Dim rptName As String
    Dim shName As String
    Dim rDate As Date
    Dim rMonth As Variant
    Dim rDay As Variant
    Dim LastRow As Long, LRow As Long, dLastRow As Long, dLrow As Long
    Dim dList As Range
    Dim rw As Long, i As Long, dCell As Range, x As Range
    Dim wb1 As Workbook
    Dim ws1 As Worksheet, Test As String
        
Application.ScreenUpdating = False
Retry1:
rDate = Application.InputBox("Please enter date of the " & _
"Report that you want to open (d/m/yy).")

If Not IsDate(rDate) Or Not rDate Like "[0-3]#/[01]#/201[0-9]" Or rDate < Now() - 7 Then 'valid dates will be 2010 t0 2019.  

If MsgBox("Invalid date or invalid date format or date goes back more than 7 days.  " & _
"Please re-enter the date in the correct format.", vbRetryCancel) = vbRetry Then
GoTo Retry1:
Else: Exit Sub
End If
End If

rDay = Format(rDate, "DD")
rMonth = Format(rDate, "MM")

rptName = "TEST" & rMonth & rDay
    
    strReport = "C:\users\" & Environ("Username") & "\desktop\" & rptName & ".DAT"

    shName = rptName

        Workbooks.OpenText Filename:=strReport _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(0, 1), _
        Array(12, 1), Array(33, 1), Array(35, 1), Array(36, 1), Array(42, 1), Array(43, 1), Array(58, 1), _
        Array(71, 1), Array(79, 1), Array(90, 1), Array(99, 1), Array(111, 1), Array(116, 1), Array(121, 1), _
        Array(125, 1), Array(129, 1), Array(194, 1)), TrailingMinusNumbers _
        :=True

LastRow = ActiveSheet.Range("A1048576:Q" & Rows.Count).End(xlUp).Row - 5

For rw = LastRow To 12 Step -1
    If Not (Left(Cells(rw, 1), 4) = "4141" Or Left(Cells(rw, 1), 4) = "4242" Or Left(Cells(rw, 1), 4) = "4343" Or Left(Cells(rw, 1), 4) = "4444" _
    Or Left(Cells(rw, 1), 4) = "4545" Or Left(Cells(rw, 1), 4) = "4646" Or Left(Cells(rw, 1), 4) = "4747" Or Left(Cells(rw, 1), 4) = "4848" _
    Or Left(Cells(rw, 1), 4) = "4949" Or Left(Cells(rw, 1), 4) = "5050" Or Left(Cells(rw, 1), 4) = "5151" Or Left(Cells(rw, 1), 4) = "5252" _
    Or Left(Cells(rw, 1), 4) = "5353") Then Rows(rw & ":" & rw).EntireRow.Delete
    
Next rw

Range("D:D").EntireColumn.Delete
Range("E:E").EntireColumn.Delete

Range("C11").FormulaR1C1 = "DIS"
Range("D11").FormulaR1C1 = "AREA"
Range("E11").FormulaR1C1 = "P_NUMBER"
               
Rows("1:10").EntireRow.Delete

        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.Range("A1:O1").AutoFilter
        ActiveSheet.Range("A1").Select
        
LRow = ActiveSheet.Range("A1048576:O" & Rows.Count).End(xlUp).Row

Rows(LRow).EntireRow.Delete

Workbooks("Report_Macro_updated.xlsm").Activate
ActiveWorkbook.Worksheets("DIS_LIST").Activate

dLastRow = ActiveSheet.Range("A" & Rows.Count & ":A" & Rows.Count).End(xlUp).Row

ActiveWorkbook.Names.Add Name:="dList", RefersTo:=Worksheets("DIS_LIST").Range("$A$1:$A$" & dLastRow)

Workbooks("TEST0729.DAT").Activate
ActiveWorkbook.Worksheets(rptName).Activate
dLrow = ActiveSheet.Range("G" & Rows.Count & ":G" & Rows.Count).End(xlUp).Row 'DIS column on report

Set dCell = Range("G2:G" & dLrow) 'all DISs on report

Set x = Workbooks("Report_Macro_updated.xlsm").Names("dList").RefersToRange

For Each Cell In dCell

'For i = 2 To dLrow
If Cell.Value = Application.WorksheetFunction.VLookup(Cell.Value, x, 1, False) Then Cell.EntireRow.Interior.ColorIndex = 6

Next

        
Application.ScreenUpdating = True
     
End Sub

Could you help me fix it, please.

Thank you,
Gos-C