I did try change the macro but the highlight not work very well, because this code highlight the empty cell as well.
Please see below my code:
Option Explicit
Function getFile() As Workbook
Dim fn As Variant
fn = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select workbook")
If TypeName(fn) <> "Boolean" Then Set getFile = Workbooks.Open(fn)
End Function
Sub useGetFile()
Dim Dic As Object
Dim key As Variant
Dim oCell As Range
Dim i As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set wb2 = getFile
If Not wb2 Is Nothing Then
On Error Resume Next
Set ws2 = wb2.Sheets("Sheet1")
On Error GoTo 0
If Not ws2 Is Nothing Then
Set wb1 = Workbooks("1.xlsx")
Set ws1 = wb1.Sheets("Sheet1")
i = ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In ws1.Range("A1:A" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, 3).Value
End If
Next
i = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In ws2.Range("A2:A" & i)
For Each key In Dic
If oCell.Value = key Then
oCell.Offset(, 3).Value = Dic(key)
oCell.Offset(, 0).Interior.ColorIndex = 37
oCell.Offset(, 1).Interior.ColorIndex = 37
oCell.Offset(, 2).Interior.ColorIndex = 37
oCell.Offset(, 3).Interior.ColorIndex = 37
oCell.Offset(, 4).Interior.ColorIndex = 37
oCell.Offset(, 5).Interior.ColorIndex = 37
oCell.Offset(, 6).Interior.ColorIndex = 37
oCell.Offset(, 7).Interior.ColorIndex = 37
End If
Next
Next
Else
MsgBox "Sheet1 not found in " & wb2.Name, vbCritical
End If
'Maybe close wb2 here?
'wb2.Close SaveChanges:=False
Else
Debug.Print "User cancelled"
End If
Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
Set Dic = Nothing
End Sub
Display More