Recon between two spreadsheets across various columns

[Kartyk]

Hello there,

I am workin on a code to compare two spreadsheets, having various columns, and identify if the data matching. I have attached a dummy file to illustrate the requirement better. There will two different workbooks, however for convenience, I have made it two spreadsheets in the same workbook.

Idea is to compare the highlighted columns and identify if it is a pass or a fail.

Columns "Account" is the unifying factor between the files. Hence, code has to look for the account and when it matches, match the other two columns of relevance ( lots and rate in this case). If they are equal, mark as "Pass" against the row. Else, "Fail".

Note : You can also note that Lots is a summed up version on the second spreadsheet. It is a valid match. One row against Many.

I hope, i have documented the requirement clearly. Would greatly appreciate your help in this regard.

Thanks in advance
18347

[Leith Ross]

Hello Kartyk,

After looking at the data on both sheets, I am not clear on what you said below.


Columns "Account" is the unifying factor between the files. Hence, code has to look for the account and when it matches, match the other two columns of relevance ( lots and rate in this case). If they are equal, mark as "Pass" against the row. Else, "Fail".

Note : You can also note that Lots is a summed up version on the second spreadsheet.


On the first sheet the total of the rates for the five matches (based on account number and lot) is 350

Lots Rate Account
90 0.6 1234
80 0.6 1234
100 0.6 1234
30 0.6 1234
50 0.6 1234


On the second sheet you have the total as 250.

Lots Rate Account
250 0.6 1234

Is the difference an oversight or am I missing something?

Will "Pass" or "Fail" be placed in the column after "Account" on the first sheet?

[Kartyk]

Hello Leith,

Thanks for your response.

Yes, it is an oversight. Total has to match both the sheets. Also, there might be cases where theres only one line on each sheet with the same account. We have two scenarios here

[Kartyk]

One where, total of all line items match the total on the other
Two, it is a straightforward case of one line each

Well, Pass or Fail can be on either sheet, probably the last column.

[Kartyk]

Any luck with this please ?

[Leith Ross]

Hello Kartyk,

This was a good challenge. The macro is based on your post. The macro compares the 2 worksheets in the workbook with the macro using the workbook object reference "ThisWorkbook". The variable for the second workbook "Wkb2" can be set to the second opened workbook. See the comments in the macro code.

The macro will add "Pass" or "Fail" to the column on the right of "Account" on each worksheet. If you only want one workbook to show this, the loop can be easily changed.

Here is the macro code added to the attached workbook.

Module1 Code


Option Explicit


Global Dict1 As Object
Global Dict2 As Object


Sub LoadDict(ByRef objDict As Object, ByRef Rng As Range)


Dim Cell As Range
Dim Dict As Object
Dim Key As Variant
Dim n As Double

If objDict Is Nothing Then
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = vbTextCompare
Else
objDict.RemoveAll
End If

For Each Cell In Rng
Key = Trim(Cell)
If Key <> "" Then
Key = Key & "_" & Cell.Offset(0, -1).Value ' Account & Rate
If Not objDict.Exists(Key) Then
objDict.Add Key, Cell.Offset(0, -2).Value ' Lots
Else
' Sum the Lots
n = objDict(Key)
objDict(Key) = n + Cell.Offset(0, -2).Value
End If
End If
Next Cell

End Sub


Sub CompareData()


Dim Cell As Range
Dim j As Long
Dim k As Long
Dim Key As String
Dim Rng As Variant
Dim Rng1 As Range
Dim Rng2 As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wkb1 As Workbook
Dim Wkb2 As Workbook
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet

Set Wkb1 = ThisWorkbook
Set Wks1 = Wkb1.Worksheets("Excel 1")

' Change this workbook to the match the second open workbook.
Set Wkb2 = ThisWorkbook 'Workbooks(2)
Set Wks2 = Wkb2.Worksheets("Excel 2")

With Wks1
Set RngBeg = .Range("H2")
Set RngEnd = .Cells(Rows.Count, RngBeg.Column).End(xlUp)
If RngEnd.Row < RngBeg.Row Then Exit Sub
Set Rng1 = .Range(RngBeg, RngEnd)
Call LoadDict(Dict1, Rng1)
End With

With Wks2
Set RngBeg = .Range("H2")
Set RngEnd = .Cells(Rows.Count, RngBeg.Column).End(xlUp)
If RngEnd.Row < RngBeg.Row Then Exit Sub
Set Rng2 = .Range(RngBeg, RngEnd)
Call LoadDict(Dict2, Rng2)
End With

Application.ScreenUpdating = False

For Each Rng In Array(Rng1, Rng2)
For Each Cell In Rng.Cells
Key = Trim(Cell.Value)
If Key <> "" Then
Key = Cell & "_" & Cell.Offset(0, -1).Value
If Dict1(Key) = Dict2(Key) Then
Cell.Offset(0, 1).Value = "Pass"
Else
Cell.Offset(0, 1).Value = "Fail"
End If
End If
Next Cell
Next Rng

Application.ScreenUpdating = True

End Sub

[Kartyk]

Thanks a lot Keith, yeah it is quite complicated and you made it look easy. However, I have couple of questions -

1 What if columsn are dynamic in nature ? They could be placed anywhere in the sheet with hundred other columns
2 I need to add few more columns for comparison, like 4 more to be precise. They are not part of example data. Some are numbers and some are texts.

Thanks a lot once again.

Cheers
K

[Leith Ross]

Hello Kartyk,

1) The macro can be modified to find a column header. I would expect the column header to be in row 1 on the worksheet. The macro currently finds the number of rows in the column.

2) I could change the macro to allow you compare any 2 columns you want. Another macro would need to be written to compare any number of column pairs. Let me know the names of the column headers and which worksheets and workbooks they are located in.

[Kartyk]

Hello Leith,

I have added the additional column names to the sheet you sent. These columns can be located anywhere in those two sheets. So, we can use Find method to locate the column.

Cheers
K

[Leith Ross]

Hello Kartyk,

Thanks, I will have a look at the workbook in the morning. It is 1:11 Am my time.

[Leith Ross]

Hello Kartyk,

Will the header names still be the same, i.e. "Account", "Rate", and "Lots"?

[Kartyk]

Hi Leith,

Yes they should be. even if its not, I can adjust the code accordingly.

Cheers
K

[Kartyk]

Also, Idea is to keep it as dynamic as possible. So that, I can implement this for other streams too.

Cheers
K

[Leith Ross]

Hello Kartyk,

Here is the updated code. The macro now searches each sheet for the location of the headers "Account", "Lots", and "Rate" in row . Case is ignored and whole words are matched. If the headers are different on the worksheet then the macro will need to be changed to use the new headers.

Updated Code:


Option Explicit


Global Dict1 As Object
Global Dict2 As Object


Function LoadDict(ByRef objDict As Object, ByRef Wks As Worksheet)


Dim Cell As Range
Dim cxLots As Long
Dim cxRate As Long
Dim Dict As Object
Dim Key As Variant
Dim n As Double
Dim rngAcct As Range
Dim rngBeg As Range
Dim rngEnd As Range
Dim rngLots As Range
Dim rngRate As Range

With Wks.Range("1:1")
Set rngAcct = .Find("Account", , xlValues, xlWhole, xlByColumns, xlNext, False, False, False)
Set rngLots = .Find("Lots"): cxLots = rngLots.Column - rngAcct.Column
Set rngRate = .Find("Rate"): cxRate = rngRate.Column - rngAcct.Column
End With

If objDict Is Nothing Then
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = vbTextCompare
Else
objDict.RemoveAll
End If

Set rngBeg = rngAcct.Offset(1, 0)
Set rngEnd = Wks.Cells(Rows.Count, rngBeg.Column).End(xlUp)

If rngEnd.Row < rngBeg.Row Then Exit Function

For Each Cell In Wks.Range(rngBeg, rngEnd)
Key = Trim(Cell)
If Key <> "" Then
Key = Key & "_" & Cell.Offset(0, cxRate).Value ' Account & Rate
If Not objDict.Exists(Key) Then
objDict.Add Key, Cell.Offset(0, cxLots).Value ' Lots
Else
' Sum the Lots
n = objDict(Key)
objDict(Key) = n + Cell.Offset(0, cxLots).Value
End If
End If
Next Cell

Set LoadDict = Wks.Range(rngBeg, rngEnd)

End Function


Sub CompareData()


Dim Cell As Range
Dim j As Long
Dim k As Long
Dim Key As String
Dim colEnd As Long
Dim Rng As Variant
Dim Rng1 As Range
Dim Rng2 As Range
Dim rngBeg As Range
Dim rngEnd As Range
Dim Wkb1 As Workbook
Dim Wkb2 As Workbook
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet

Set Wkb1 = ThisWorkbook
Set Wks1 = Wkb1.Worksheets("Excel 1")

' Change this workbook to the match the second open workbook.
Set Wkb2 = ThisWorkbook 'Workbooks(2)
Set Wks2 = Wkb2.Worksheets("Excel 2")

Application.ScreenUpdating = False

Set Rng1 = LoadDict(Dict1, Wks1)
Set Rng2 = LoadDict(Dict2, Wks2)

For Each Rng In Array(Rng1, Rng2)
colEnd = Rng.Parent.Cells(1, Columns.Count).End(xlToLeft).Column + 1
For Each Cell In Rng.Cells
Key = Trim(Cell.Value)
If Key <> "" Then
Key = Cell & "_" & Cell.Offset(0, -1).Value
If Dict1(Key) = Dict2(Key) Then
Cell.Offset(0, colEnd - Cell.Column).Value = "Pass"
Else
Cell.Offset(0, colEnd - Cell.Column).Value = "Fail"
End If
End If
Next Cell
Next Rng

Application.ScreenUpdating = True

End Sub

[Kartyk]

Thanks a lot Leith, however, find has to be for other newly added columns too. All the columns added to the right of Account also needs validation.

I am trying to edit it and will let you know if i face any difficulty.

Thanks a lot for bringing this far.

Cheers
K

[Leith Ross]

Hello Kartyk,

Sorry, I misunderstood your last post. Do these new columns need to be validated using Account?

[Kartyk]

Yes, please. I am working on it. This is what I added, but with no luck thus far.

For Each Cell In Wks.Range(rngBeg, rngEnd)
Key = Trim(Cell)
If Key <> "" Then
Key = Key & "_" & Cell.Offset(0, cxRate).Value ' Account & Rate
Key1 = Key & "_" & Cell.Offset(0, cxGPS).Value ' GPS
Key2 = Key & "_" & Cell.Offset(0, cxProd).Value ' Productcode
Key3 = Key & "_" & Cell.Offset(0, cxExch).Value ' Exchangecode
Key4 = Key & "_" & Cell.Offset(0, cxDate).Value ' Date
If Not objDict.Exists(Key) Then
objDict.Add Key, Cell.Offset(0, cxLots).Value ' Lots
Else
' Sum the Lots
n = objDict(Key)
objDict(Key) = n + Cell.Offset(0, cxLots).Value
End If
End If
Next Cell

Set LoadDict = Wks.Range(rngBeg, rngEnd)

End Function


Sub CompareData()


Dim Cell As Range
Dim j As Long
Dim k As Long
Dim Key As String, Key1 As String, Key2 As String, Key3 As String, Key4 As String
Dim colEnd As Long
Dim Rng As Variant
Dim Rng1 As Range
Dim Rng2 As Range
Dim rngBeg As Range
Dim rngEnd As Range
Dim Wkb1 As Workbook
Dim Wkb2 As Workbook
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet

Set Wkb1 = ThisWorkbook
Set Wks1 = Wkb1.Worksheets("Excel 1")

' Change this workbook to the match the second open workbook.
Set Wkb2 = ThisWorkbook 'Workbooks(2)
Set Wks2 = Wkb2.Worksheets("Excel 2")

Application.ScreenUpdating = False

Set Rng1 = LoadDict(Dict1, Wks1)
Set Rng2 = LoadDict(Dict2, Wks2)

For Each Rng In Array(Rng1, Rng2)
colEnd = Rng.Parent.Cells(1, Columns.Count).End(xlToLeft).Column + 1
For Each Cell In Rng.Cells
Key = Trim(Cell.Value)
If Key <> "" Then
Key = Cell & "_" & Cell.Offset(0, -1).Value
Key1 = Cell & "_" & Cell.Offset(0, -1).Value
Key2 = Cell & "_" & Cell.Offset(0, -1).Value
Key3 = Cell & "_" & Cell.Offset(0, -1).Value
Key4 = Cell & "_" & Cell.Offset(0, -1).Value
If Dict1(Key) = Dict2(Key) And Dict1(Key2) = Dict2(Key2) And Dict1(Key3) = Dict2(Key3) And Dict1(Key4) = Dict2(Key4) Then
Cell.Offset(0, colEnd - Cell.Column).Value = "Pass"
Else
Cell.Offset(0, colEnd - Cell.Column).Value = "Fail"

[Leith Ross]

Hello Kartyk,

It looks like you want to sum the lots for an account only if the Rate, GPS, ProductCode, ExchangeCode, and date are the same for both sheets.

Is this correct?

[Kartyk]

Hello Leith,

It can be independent too. Logic is, all these parameters should match for a pass. Else, it fails.

Cheers
K

[Leith Ross]

Hello Kartyk,

I will need to think this over in the morning. I am too tired to think about it at 1:48 AM California time.

[Kartyk]

Oh boy !! That is too late in the night to even work.

Goodnight

[Kartyk]

Yeah, that is too late to think of work, even for the one who breathes VBA.

Cheers
K

[Kartyk]

One other thing I noticed is the second part of the query still points to rate being picked up from 1 column before Account. Hence, it is not dynamic. Should the column move places, macro fails.

This part :


For Each Rng In Array(Rng1, Rng2)
colEnd = Rng.Parent.Cells(1, Columns.Count).End(xlToLeft).Column + 1
For Each Cell In Rng.Cells
Key = Trim(Cell.Value)
If Key <> "" Then
Key = Cell & "_" & Cell.Offset(0, -1).Value
If Dict1(Key) = Dict2(Key) Then
Cell.Offset(0, colEnd - Cell.Column).Value = "Pass"
Else
Cell.Offset(0, colEnd - Cell.Column).Value = "Fail"
End If
End If
Next Cell
Next Rng
Cheers
K

[Kartyk]

Hi,

Any update pls ?

Cheers
K

[Kartyk]

Hi,

Any update please ?

Regards
Karthik