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!

 

[jindon]

Hi

sorry, should be like this

    .Offset(i,UBound(y(i))-1).Value = "Droped"

 

[TiffanyG]

Thanks!
That works great!
Really appreciate the help!

Tiffany

 

[jindon]

Tiffany,

As you already have understood, no need to sort the range, no need to care about the size of the range as long as both sheet has same number of columns.

 

[TiffanyG]

If I have to add another column what do I do then? Today at work they were asking me if they could add another column. I said ??????

 

[jindon]

OK

The code will generate the report as long as:

1) Both sheets have identical number of columns and start from col.A
2) Col.A has ID to compare
3) testing for change, dropped, remain must be col.C

The above are the conditions to use

 

[TiffanyG]

Thanks so much!!

Tiffany

 

[Fazza]

Tiffany,

I've modified the SQL in the query so that now it will return all columns. 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".

HTH, Fazza

Sub Report()
    
    Dim sConn As String
    Dim sSQL As String
    
    Dim wks As Worksheet
    
    Worksheets("1Q").Range("A1").CurrentRegion.Name = "tbl_1Q"
    Worksheets("2Q").Range("A1").CurrentRegion.Name = "tbl_2Q"
    
    sConn = "ODBC;DSN=Excel Files;DBQ=" & _
            ActiveWorkbook.FullName & _
            ";DefaultDir=" & ActiveWorkbook.Path & _
            ";DriverID=790;MaxBufferSize=2048;PageTimeout=5;"
    
    sSQL = "SELECT 'Removed 2Q' AS [Account Change], tbl_1Q.*" & vbCr & _
            "FROM {oj tbl_1Q tbl_1Q LEFT OUTER JOIN tbl_2Q tbl_2Q ON tbl_1Q.`Account #` = tbl_2Q.`Account #`}" & vbCr & _
            "WHERE (tbl_2Q.`Account #` Is Null)" & vbCr & _
            "UNION" & vbCr & _
            "SELECT 'Added 2Q' AS [Account Change], tbl_2Q.*" & vbCr & _
            "FROM {oj tbl_2Q tbl_2Q LEFT OUTER JOIN tbl_1Q tbl_1Q ON tbl_2Q.`Account #` = tbl_1Q.`Account #`}" & vbCr & _
            "WHERE (tbl_1Q.`Account #` Is Null)" & vbCr & _
            "UNION" & vbCr & _
            "SELECT 'Risk Change 2Q' AS [Account Change], tbl_2Q.*" & vbCr & _
            "FROM tbl_1Q tbl_1Q, tbl_2Q tbl_2Q" & vbCr & _
            "WHERE tbl_2Q.`Account #` = tbl_1Q.`Account #` AND tbl_2Q.`Risk Grade` <> tbl_1Q.`Risk Grade`"
    
    Set wks = Worksheets.Add
    
    With wks
        .Name = "Report " & Format$(Now, "h.mm am/pm d mmm yy")
        With .QueryTables.Add(Connection:=sConn, Destination:=.Range("A1"), Sql:=sSQL)
            .Refresh BackgroundQuery:=False
        End With
        .Move
    End With
    Set wks = Nothing
    
End Sub

 

[jindon]

Nice!

I like it.

 

[Fazza]

Me, too, Jindon. I liked this sort of stuff enough to be motivated to learn a little SQL - I am 100% Excel normally, never use other software - and you can do some powerful stuff really simply. Some stuff you can do other ways anyway, some stuff though you would struggle to do a different way and the SQL can make some things easy & fast. It is good too how it works on closed workbooks.

Keep excelling, season's greetings, Fazza

 

[TiffanyG]

Thanks so much Fazza. I have learned so much from you and jindon.

Have a nice Christmas!