Compare Sheets

[TiffanyG]

I prepare quarterly reports and need to pick up any new accounts but also need to report accounts that were lost. Each account has a unique account number and all info about the account is in one row. For instance:

Sheet - 1Q
Branch Act # Name Rate Code
1 321 John Doe 6

Sheet - 2Q
1 321 Joh Doe 5

I want a VB Code that will compare 1Q and 2Q pick up this row and show it is now rated a 5 instead of 6 in a new sheet named consolidation. BUT if any accounts are new 2Q I need to pick them up OR if any have dropped off and are not on the 2Q I need pick them up.

Is this possible? I use VB but can only do simple procedures.
Any help is greatly appreciated!

 

[TiffanyG]

Fazza,
I tried the new code and it stops at the bottom where it adds a new sheet

 .Refresh Background Query: = False

with an error that says

Run-time error '1004': General ODBC Error

Am I doing something wrong?

 

[Fazza]

Hi Tiffany,

There is not much that can be wrong. I suspect the basic criteria are not being met. From above,

You can have as many columns as you like and any names and in any order - so long as both lists have matching headers and you have headers "Account #" and "Risk Grade".

So, if you start on sheet Q1 from cell A1 of the block of contiguous cells that includes that cell and go across all the columns, each one should have a header and these should match the same ones on sheet Q2. The headers should be matching between the two sheets. There should be no missing headers. The headers should include one called "Account #" and one called "Risk Grade". If that is OK, then AFAIK it should work fine.

If not, please post again. HTH, Fazza

 

[TiffanyG]

Thanks, I'll check it tomorrow.

Tiffany

 

[benpete]

So, Did you figure out why you were getting that error? I was playing with this and it I got the same error at first, but then the next day it worked twice in a row. Then is started giving me the same error again?

 

[sipasa]

The code worked just perfect for me. I made a small adjustment to suits me the number of the changing column (6) and all went well but when I added an extra changing column (5) than the code didn't picked the change for some reason.


Here is the code I am using:




Sub test()
Dim a, i As Long, ii As Integer, w(), dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1") '<- alter to suite
a = .Range("a1").CurrentRegion.Value
End With
For i = 1 To UBound(a, 1)
If Not dic.exists(a(i, 1)) Then
ReDim w(1 To UBound(a, 2) + 1)
For ii = 1 To UBound(a, 2): w(ii) = a(i, ii): Next
dic.Add a(i, 1), w
End If
Next
With Sheets("Sheet2")
a = .Range("a1").CurrentRegion.Value
End With
For i = 1 To UBound(a, 1)
If Not dic.exists(a(i, 1)) Then
ReDim w(1 To UBound(a, 2) + 1)
For ii = 1 To UBound(a, 2): w(ii) = a(i, ii): Next
w(UBound(w)) = "New": dic.Add a(i, 1), w
Else
w = dic(a(i, 1))
If w(UBound(w)) <> "New" Then
If w(5) <> a(i, 5) Then
w(5) = a(i, 5): w(UBound(w)) = "Changed"
Else
w(UBound(w)) = "Remain"
End If
End If
dic(a(i, 1)) = w
End If
If w(UBound(w)) <> "New" Then
If w(6) <> a(i, 6) Then
w(6) = a(i, 6): w(UBound(w)) = "Changed"
Else
w(UBound(w)) = "Remain"
End If
End If
dic(a(i, 1)) = w
Next
y = dic.items: Set dic = Nothing: Erase a
With Sheets("Consolidate").Range("a1")
.CurrentRegion.ClearContents
.EntireRow.Value = Sheets("Sheet1").Rows(1).Value ' Alter sheet name if needed
.End(xlToRight).Offset(, 1).Value = "Status"
For i = 1 To UBound
.Offset(i).Resize(, UBound(y(i))).Value = y(i)
If IsEmpty(y(i)(UBound(y(i)))) Then
.Offset(i, UBound(y(i)) - 1).Value = "Droped"
End If
Next
End With
End Sub


What I am missing? Thank you.