match cells based on a string provided

Hi,

I need help to create a vba function that helps to match data.

I got a string that contains invoice no, company name, type and date.

I need to create a function to match the string with a list of invoice no. from a column in another sheet.

If the string and invoice no. are matched, it will then proceed to match the company name, type and date from the same row as the invoice no.


The box will turn green if the information matches the string
The box will turn red if the information does not match the string

An example of the result. Attachment 24474

Thank you

Code:

---

Option Explicit


Sub test()
    Dim dic As Object
    Dim v
    Dim k As Long
    Dim r As Range
    Dim c As Range
    Dim s
    Dim inv As String
   
    Set dic = CreateObject("scripting.dictionary")
   
    v = Sheets("sheet2").Cells(1).CurrentRegion
   
    For k = 2 To UBound(v)
        dic(CStr(v(k, 1))) = Array(v(k, 2), v(k, 3), v(k, 4))
    Next
   
    Set r = Sheets("sheet1").Cells(1).CurrentRegion.Columns(3)
    Set r = r.Resize(r.Rows.Count - 1).Offset(1)
   
    r.Offset(, 4).Resize(, 4).Interior.Color = vbGreen
   
  For Each c In r.Cells
        s = Split(c.Value & c.Offset(, 1).Value)
        inv = s(2)
        If Not dic.exists(inv) Then
            c.Offset(, 4).Resize(, 4).Interior.Color = vbRed
        Else
            If dic(inv)(0) <> s(0) Then c.Offset(, 5).Interior.Color = vbRed
            If dic(inv)(1) <> s(1) Then c.Offset(, 6).Interior.Color = vbRed
            If dic(inv)(2) <> DateValue(s(4)) Then c.Offset(, 7).Interior.Color = vbRed
        End If
  Next
   
End Sub

---

Thanks! It works perfectly