User define to compare worksheets

[nickmax1]

I want a macro that asks the user to define two worksheets in a workbook, and the macro then returns differences between the two sheets

more is explained in the attachment

Compare.xlsm

[arlu1201]

Do you want the output in 2 sheets?

Return the rows that do NOT feature in the earlier spreadsheet. (ie what accounts feature in Aug 2012 but do not feature in Aug 2013 - in this instance the result to be returned is Tsogo Sun

Is it a typo? Did you mean accounts featuring in Aug 2013 but not in 2012?

[nickmax1]

Do you want the output in 2 sheets?



Is it a typo? Did you mean accounts featuring in Aug 2013 but not in 2012?

No, not a typo. I want to know what accounts from the past do not feature anymore

[nickmax1]

The output can be on one sheet if possible, perhaps starting in a sheet called "Whatever" (so I can rename as I see fit) starting from row 25 or so.

[nickmax1]

Is that possible?

[arlu1201]

Its possible.

One question - When you say - Ask user to define a month and year (MMM YYYY) with another (MMM YYYY) - the user needs to specify the sheet names right?

What if the user specifies the 1st month and year as Aug 2012 and the 2nd as Sept 2013 or even Sept 2012? Should it proceed?

[nickmax1]

Yes the user needs to specify the sheet names.

I think that if the sheets exist it should still proceed with the comparison. Perhaps make it so that there is a drop down list of available sheets?

[arlu1201]

You want a dropdown of available sheets to be created by code? This can be done, however since its done by code, you will need to specify when you want this code to be triggered - when the Summary sheet is activated or when the file is opened?

Its better if you ask that in a separate thread. I will help you with the comparison code.

[nickmax1]

I see no I dont want to complicate things, just the code is fine!

[arlu1201]

When you want to see the difference in premium, do you want to see rows from both the sheets or only the 2013 sheet?

Where should the difference in premium show? In column F itself or in a separate column?

[nickmax1]

For the difference in premium I would like to see both rows (from 2012 and 2013)

Ideally it would be displayed in a new sheet called "Whatever", so if there is a difference in premium between account X in 2012 and X in 2013 display like this maybe (just a suggestion)

Sep 2012 Account X Premium Y
Sep 2013 Account X Premium Y

If there is an Account X in Sep 2012 that doesnt exist in Sep 2013 maybe display
Sep 2012 - Account X

[arlu1201]

Is it ok if i display the whole row of data or do you want only particular columns?

[nickmax1]

Whole row is fine!

[arlu1201]

Try this code

Option Explicit

Sub compare_sheets()
Dim lrow As Long, lrow1 As Long, i As Long
Dim sname As String, sname1 As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets("Diff of Prm").Delete
Worksheets("Do not feature").Delete

Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Diff of Prm"
sname = Format(Worksheets("Summary").Range("C14").Value, "MMM YYYY")
Worksheets(sname).Range("A16:Q16").Copy Worksheets("Diff of Prm").Range("A1")
sname1 = Format(Worksheets("Summary").Range("C16").Value, "MMM YYYY")
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Do not feature"
Worksheets(sname).Range("A16:Q16").Copy Worksheets("Do not feature").Range("A1")

Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Temp"

With Worksheets("Temp")
    Worksheets(sname).Range("A16:Q16").Copy .Range("A1")
    Worksheets(sname).Range("A18:Q190").Copy .Range("A2")
    .Range("R1").Value = "Sheet"
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("R2:R" & lrow).Value = sname
    
    Worksheets(sname1).Range("A18:Q190").Copy .Range("A" & lrow + 1)
    lrow = .Range("R" & .Rows.Count).End(xlUp).Row
    lrow1 = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("R" & lrow + 1 & ":R" & lrow1).Value = sname1
    
    .Sort.SortFields.Add Key:=Range("A:A") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   .Sort.SortFields.Add Key:=Range("C:C") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range("A:R")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For i = 2 To lrow1
        If .Range("C" & i).Value = .Range("C" & i + 1).Value Then
            If .Range("F" & i).Value <> .Range("F" & i + 1).Value Then
                .Range("A" & i & ":R" & i + 1).Copy Worksheets("Diff of Prm").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                i = i + 1
            End If
        ElseIf .Range("C" & i).Value <> .Range("C" & i + 1).Value And Format(.Range("R" & i).Value, "MMM YYYY") = sname Then
            .Range("A" & i & ":Q" & i).Copy Worksheets("Do not feature").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next i
End With

Worksheets("Temp").Delete

MsgBox "Comparison Done"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

See attached file on how i used the dropdowns and the button.

[nickmax1]

Wow that is great! Any chance that instead of it creating two new sheets (diff of prm and Do not Feature) the Summary sheet itself has a static title in say Row 23 called "Premium Differences" and another header in row 40 called Does Not Feature and the relevant rows get places accordingly?

[arlu1201]

Wow that is great! Any chance that instead of it creating two new sheets (diff of prm and Do not Feature) the Summary sheet itself has a static title in say Row 23 called "Premium Differences" and another header in row 40 called Does Not Feature and the relevant rows get places accordingly?

What if the rows cross the number of rows between both the sections?

[nickmax1]

i almost got it but am having trouble getting the macro to "plonk" the data in the right rows in my summary page!

[nickmax1]

I dont think there will ever be that many differences between sheets.... maybe have the title in row 23 for prm diff and the other header start at 45.

[nickmax1]

or is there some kind of range that can be "defined"?

[arlu1201]

Updated code -

Option Explicit

Sub compare_sheets()
Dim lrow As Long, lrow1 As Long, i As Long
Dim sname As String, sname1 As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

sname = Format(Worksheets("Summary").Range("C14").Value, "MMM YYYY")
sname1 = Format(Worksheets("Summary").Range("C16").Value, "MMM YYYY")

With Worksheets("Summary")
    .Range("A25:Q39").ClearContents
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    If lrow > 41 Then .Range("A42:Q" & lrow).ClearContents
End With

Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Temp"

With Worksheets("Temp")
    Worksheets(sname).Range("A16:Q16").Copy .Range("A1")
    Worksheets(sname).Range("A18:Q190").Copy .Range("A2")
    .Range("R1").Value = "Sheet"
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("R2:R" & lrow).Value = sname
    
    Worksheets(sname1).Range("A18:Q190").Copy .Range("A" & lrow + 1)
    lrow = .Range("R" & .Rows.Count).End(xlUp).Row
    lrow1 = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("R" & lrow + 1 & ":R" & lrow1).Value = sname1
    
    .Sort.SortFields.Add Key:=Range("A:A") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("C:C") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range("A:R")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For i = 2 To lrow1
        If .Range("C" & i).Value = .Range("C" & i + 1).Value Then
            If .Range("F" & i).Value <> .Range("F" & i + 1).Value Then
                .Range("A" & i & ":R" & i + 1).Copy Worksheets("Summary").Range("A39").End(xlUp).Offset(1, 0)
                i = i + 1
            End If
        ElseIf .Range("C" & i).Value <> .Range("C" & i + 1).Value And Format(.Range("R" & i).Value, "MMM YYYY") = sname Then
            .Range("A" & i & ":Q" & i).Copy Worksheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next i
End With

Worksheets("Temp").Delete

MsgBox "Comparison Done"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

See attached file -

[arlu1201]

You need to put the headings and the column headers.

[nickmax1]

pure genius....what do you mean about putting headings and colomn headers? They are already there>?

Or do you mean you cant remove them or the macro wont work?

[arlu1201]

No, no i meant you need to put the headings from row 16 into your 2 sections. The macro wont do it (though it can if you want me to add that in).

Also you need to put the main headers like "Does not feature" and "Prem Difference".

[arlu1201]

If you want the dropdowns to be populated by a macro, it can be done.

Just create a new thread and i can help you with it.