Message box inputs for a working macro, can anyone help?

rkol297

Board Regular
Joined
Nov 12, 2010
Messages
125
Below is a code that I use to remove duplicates from column "L" based on dates in column "K". Basically this code works perfectly fine, however, what I want to do is have a message box pop up when the macro is run to ask which column contains duplicates? and have the response typed in set the value for the code replacing "L". A second box would then pop up and ask where are the dates to be analyzed and have this response set the value for what is now "K" in the code below.




Sub NewestReorder()
Dim Rng As Range
Dim LastRow As Long
Dim i As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "L").End(xlUp).Row
Set Rng = Range("L1:K" & LastRow)
With Rng
.Sort key1:=Range("L1"), order1:=xlAscending, key2:=Range("K1"), order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
For i = LastRow To 2 Step -1
If WorksheetFunction.CountIf(Range(Cells(2, "L"), Cells(i, "L")), Cells(i, "L")) > 1 Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Mohammad Basem

Well-known Member
Joined
Dec 24, 2011
Messages
1,218
Try this,
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Sub NewestReorder()

    Dim Rng As Range
    Dim LastRow As Long
    Dim i As Long
    Dim sDupColumn As String, sDateColumn As String

    sDupColumn = InputBox("Specify column letter which contains duplicates", "Duplicate Column")
    If sDupColumn = "" Then Exit Sub        [COLOR="Green"]'* Empty value entered or action cancelled[/COLOR]
    sDateColumn = InputBox("Specify column letter of dates to be analyzed", "Date Column")
    If sDateColumn = "" Then Exit Sub       [COLOR="Green"]'* Empty value entered or action cancelled[/COLOR]

    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, sDupColumn).End(xlUp).Row
    Set Rng = Range(sDupColumn & "1:" & sDateColumn & LastRow)

    With Rng
        .Sort key1:=Range(sDupColumn & 1), order1:=xlAscending, key2:=Range(sDateColumn & 1), _
            order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom
    End With
    For i = LastRow To 2 Step -1
        If WorksheetFunction.CountIf(Range(Cells(2, sDupColumn), Cells(i, sDupColumn)), Cells(i, sDupColumn)) > 1 Then
            Rows(i).Delete
        End If
    Next i
    Application.ScreenUpdating = True

End Sub[/COLOR][/SIZE][/FONT]
 

Watch MrExcel Video

Forum statistics

Threads
1,123,493
Messages
5,601,998
Members
414,490
Latest member
Rip181

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top