Sort Dynamic Ranges using a Command Button

[Denny57]

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

 

[HaHoBe]

Hi Denny57,

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

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

 

[Denny57]

Hi Denny57,

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

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

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.

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

 

[HaHoBe]

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:

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

 

[Denny57]

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