Sort Dynamic Ranges using a Command Button

D

Denny57

Board Regular
Joined
Nov 23, 2015
Messages
246
Office Version
  1. 365
Platform
  1. Windows
I am creating a worksheet into which additional records will be added on a regular basis. via a user form

I need to sort the data using two different criteria
1) Item detail number (not unique) as the same item may change several times and then
2) by the change date (format mm/yyyyy)
I have created a command button to which I would like to add some VBA code to select all records in the worksheet and sort in ascending order.

The order should be to sort by column C and then by Column T

First detail is in Column C - Starting at C4
Second detail is in Column T - Starting at T4
The Button is cmdSortRecords

I understand that I will need to apply a dynamic range to allow for additional records by am not sure how to achieve this when sorting by multiple criteria

Can someone please help

Many thanks
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
Hi Denny57,

this sniplet should give you a hint on how to handle the sorting:

VBA Code: 
Dim lngLast           As Long
Dim wksAct            As Worksheet

Const cstrSort1       As String = "C"
Const cstrSort2       As String = "T"
Const clngHeader      As Long = 3

'change to suit
Set wksAct = ActiveSheet

With wksAct
  lngLast = .Cells(.Rows.Count, cstrSort1).End(xlUp).Row
  With .Sort.SortFields
    .Clear
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort1), wksAct.Cells(lngLast, cstrSort1)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort2), wksAct.Cells(lngLast, cstrSort2)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
  End With
  With .Sort
      .SetRange wksAct.Range("A" & clngHeader).Resize(lngLast - 2, wksAct.Cells(3, wksAct.Columns.Count).End(xlToLeft).Column)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
End With

Set wksAct = Nothing

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi Denny57,

this sniplet should give you a hint on how to handle the sorting:

VBA Code: 
Dim lngLast           As Long
Dim wksAct            As Worksheet

Const cstrSort1       As String = "C"
Const cstrSort2       As String = "T"
Const clngHeader      As Long = 3

'change to suit
Set wksAct = ActiveSheet

With wksAct
  lngLast = .Cells(.Rows.Count, cstrSort1).End(xlUp).Row
  With .Sort.SortFields
    .Clear
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort1), wksAct.Cells(lngLast, cstrSort1)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort2), wksAct.Cells(lngLast, cstrSort2)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
  End With
  With .Sort
      .SetRange wksAct.Range("A" & clngHeader).Resize(lngLast - 2, wksAct.Cells(3, wksAct.Columns.Count).End(xlToLeft).Column)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
End With

Set wksAct = Nothing

Ciao,
Holger
Click to expand...
Hi Holger

I have added another sort range and applied the Worksheet Name. However before these were added I copied the code you provided into the code as a module for the cmdSortRecords command.

I keep getting the error

Member identifier already exists in object module from which this object module derives​

I have examined the rest for the code but cannot find the cause for the error message.

here is the entire code.

VBA Code: 
Private Sub UserForm_Initialize()

    cboChangeType.Value = "Amendment"
    cboStockType.Value = "EMU"
    txtStockNumber.Value = ""
    cboNewStatus.Value = ""
    txtShunterMovementFrom.Value = ""
    txtShunterMovementTo.Value = ""
    txtPoolCodeFrom.Value = ""
    txtPoolCodeTo.Value = ""
    txtOperatorCodeFrom.Value = ""
    txtOperatorCodeTo.Value = ""
    txtDepotCodeFrom.Value = ""
    txtDepotCodeTo.Value = ""
    txtNewOwnershipCode.Value = ""
    txtNewLiveryCode.Value = ""
    txtNamingAdded.Value = ""
    txtNamingRemoved.Value = ""
    txtRenumberingFrom.Value = ""
    txtRenumberingTo.Value = ""
    txtOtherChange.Value = ""
    txtDateOfChange.Value = "12/2022"
End Sub
Private Sub cmdAddRecord_Click()
'Used to add new records to the database
Worksheets("Change Records").Activate

Dim lastrow As Long

lastrow = Sheets("Change Records").Range("A" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "A").Value = cboChangeType
Cells(lastrow + 1, "B").Value = cboStockType
Cells(lastrow + 1, "C").Value = txtStockNumber
Cells(lastrow + 1, "D").Value = cboNewStatus
Cells(lastrow + 1, "E").Value = txtShunterMovementFrom
Cells(lastrow + 1, "F").Value = txtShunterMovementTo
Cells(lastrow + 1, "G").Value = txtPoolCodeFrom
Cells(lastrow + 1, "H").Value = txtPoolCodeTo
Cells(lastrow + 1, "I").Value = txtOperatorCodeFrom
Cells(lastrow + 1, "J").Value = txtOperatorCodeTo
Cells(lastrow + 1, "K").Value = txtDepotCodeFrom
Cells(lastrow + 1, "L").Value = txtDepotCodeTo
Cells(lastrow + 1, "M").Value = txtNewOwnershipCode
Cells(lastrow + 1, "N").Value = txtNewLiveryCode
Cells(lastrow + 1, "O").Value = txtNamingAdded
Cells(lastrow + 1, "P").Value = txtNamingRemoved
Cells(lastrow + 1, "Q").Value = txtRenumberingFrom
Cells(lastrow + 1, "R").Value = txtRenumberingTo
Cells(lastrow + 1, "S").Value = txtOtherChange
Cells(lastrow + 1, "T").Value = txtDateOfChange

MsgBox cboChangeType & " has been added to the database", 0, "Record Added"

With ActiveSheet
  Application.Goto Reference:=.Cells(.Rows.Count, "A").End(xlUp).Offset(-20), Scroll:=True
End With

Call UserForm_Initialize
cboChangeType.SetFocus

End Sub
Private Sub txtStockNumber_AfterUpdate()
'Used for Passenger stock to split the input from 6 digits to 3+3 digits
If Len(txtStockNumber.Text) = 6 And InStr(txtStockNumber.Text, " ") = 0 Then
    txtStockNumber.Text = Left(txtStockNumber, 3) & " " & Right(txtStockNumber, 3)
End If
End Sub
Private Sub txtRenumberingFrom_AfterUpdate()
'Used for Passenger stock to split the input from 6 digits to 3+3 digits
If Len(txtRenumberingFrom.Text) = 6 And InStr(txtRenumberingFrom.Text, " ") = 0 Then
    txtRenumberingFrom.Text = Left(txtRenumberingFrom, 3) & " " & Right(txtRenumberingFrom, 3)
End If
End Sub
Private Sub txtRenumberingTo_AfterUpdate()
'Used for Passenger stock to split the input from 6 digits to 3+3 digits
If Len(txtRenumberingTo.Text) = 6 And InStr(txtRenumberingTo.Text, " ") = 0 Then
    txtRenumberingTo.Text = Left(txtRenumberingTo, 3) & " " & Right(txtRenumberingTo, 3)
End If
End Sub
Private Sub cmdSortRecords()

Dim lngLast           As Long
Dim wksAct            As Worksheet

Const cstrSort1       As String = "B"
Const cstrSort2       As String = "C"
Const cstrSort3       As String = "T"
Const clngHeader      As Long = 3

'change to suit
Set wksAct = Sheets("Change Records")

With wksAct

  lngLast = .Cells(.Rows.Count, cstrSort1).End(xlUp).Row
  With .Sort.SortFields
    .Clear
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort1), wksAct.Cells(lngLast, cstrSort1)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort2), wksAct.Cells(lngLast, cstrSort2)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    .Add2 Key:=wksAct.Range(wksAct.Cells(clngHeader, cstrSort3), wksAct.Cells(lngLast, cstrSort3)), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
  End With
  With .Sort
      .SetRange wksAct.Range("A" & clngHeader).Resize(lngLast - 2, wksAct.Cells(3, wksAct.Columns.Count).End(xlToLeft).Column)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
End With

Set wksAct = Nothing

End Sub
Private Sub cmdClearForm_Click()

Call UserForm_Initialize
End Sub
Private Sub cmdCloseForm_Click()
Unload Me
End Sub

Hoping you can direct me in the right direction

David
 
Upvote 0
Hi David,

Member identifier already exists in object module from which this object module derives. I inserted the code but of course I lack all the controls and nothing obvious showed up I'm afraid.

Maybe the old sort will suit better here:

VBA Code: 
Dim lngLast           As Long
Dim wksAct            As Worksheet

Const cstrSort1       As String = "C"
Const cstrSort2       As String = "N"
Const clngHeader      As Long = 3

'change to suit
Set wksAct = Worksheets("Change Records")

With wksAct
  lngLast = .Cells(.Rows.Count, cstrSort1).End(xlUp).Row
  .Sort.SortFields.Clear

  .Range(.Cells(clngHeader, "A"), .Cells(lngLast, cstrSort2)).Sort _
                                Key1:=.Cells(clngHeader, cstrSort1), _
                                Key2:=.Cells(clngHeader, cstrSort2), _
                                Header:=xlYes, _
                                Order1:=xlAscending, _
                                Order2:=xlAscending
  .Sort.SortFields.Clear
End With

Set wksAct = Nothing

Ciao,
Holger
 
Upvote 0
Hi Holger

I eventualy found the cause of the problem..I omitted the "_Click() " in the sub routine header.

Hopefully your code will work now
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Command buttons not sorting - and sometimes jumping around on sort
2
Replies
10
Views
183
netxtown
N
A
  • Question Question
Quirk selects invisible ComboBox when clicking nearby visible Command Button
Replies
1
Views
28
AnthK
A
D
  • Solved
SUM of Columns based on multiple criteria with User Form
2
Replies
15
Views
364
Alex Blakenburg
A
L
  • Question Question
VBA - Run time error '9': subscript out of range
Replies
3
Views
271
RoryA
RoryA
D
  • Question Question
Sort varying length table by custom conditions
Replies
0
Views
260
dewy0823
D

Forum statistics

Threads
1,224,829
Messages
6,181,224
Members
453,025
Latest member
Hannah_Pham93

Share this page

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
Back
Top