使用VBA代码自定义排序

Question

For the following piece of code, I am getting a Runtime error '13', Type Mismatch Error when it reaches the following piece of code

ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
f, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal

That piece of code above is in the full code below, I have placed it in bold, it is towards the end of the code.

What I am trying to do is Filter by the Current State Column (which works fine), then I want it to do a custom sort by the 2nd and 3rd columns ("PCR No." and "Accn. ID" respectively). It will work fine if I just used the original recorded code (Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=) but the thing is I want to ensure the macro does not break if I decided to a column later at the beginning so I am trying to get it to do the custom sort by column name not column number.

Any help would be appreciated here.

Sub CommercialView() ' ' CommercialView Macro '

  ' Dim wrkbk, sourceBk As Workbook Set sourceBk = Application.ActiveWorkbook 'Clear Filter for all Columns START With ActiveSheet If .AutoFilterMode Then If .FilterMode Then .ShowAllData End If Else If .FilterMode Then .ShowAllData End If End If End With 'Clear Filter from all Columns END

  'Copy the required columns and add them to the destination spreadsheet START
  Workbooks.Add
  Set wrkbk = Application.ActiveWorkbook
  sourceBk.Activate
  wrkbk.Activate
  sourceBk.Activate

  Dim aCell1, aCell2, aCell3, aCell4, aCell5, aCell6, aCell7, aCell8, aCell9, aCell10, aCell11, aCell12 As Range
  Dim strSearch1, strSearch2, strSearch3, strSearch4, strSearch5, strSearch6, strSearch7, strSearch8, strSearch9, strSearch10, strSearch11, strSearch12 As String

  strSearch1 = "Change Request Description"
  strSearch2 = "PCR No."
  strSearch3 = "Accn. ID"
  strSearch4 = "Current State"
  strSearch5 = "Approved Date"
  strSearch6 = "Project"
  strSearch7 = "Planned Commencement Date"
  strSearch8 = "Notes"
  strSearch9 = "Total Price (IIA, DIA, Execution ($)"
  strSearch10 = "Price Calculator Status"
  strSearch11 = "OM Entry"
  strSearch12 = "CVP Ref. No."

  Set aCell1 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch1, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell2 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch2, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell3 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch3, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell4 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch4, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell5 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch5, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell6 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch6, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell7 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch7, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell8 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch8, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell9 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch9, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell10 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch10, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell11 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch11, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  Set aCell12 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch12, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)

  '~~> Do the copying here

  Sheets("3. PMO Internal View").Range(Sheets("3. PMO Internal View").Columns(aCell1.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell2.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell3.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell4.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell5.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell6.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell7.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell8.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell9.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell10.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell11.Column).Address & "," _
        & Sheets("3. PMO Internal View").Columns(aCell12.Column).Address).Copy

  'Range("A1,B1,C1,D1,E1,G1,H1,I1,R1,V1,W1,X1").EntireColumn.Select
  'Selection.Copy

  Range("A2").Select
  wrkbk.Activate
  ActiveSheet.Paste
  Selection.AutoFilter
  'Copy the required columns and add them to the destination spreadsheet END

  'To remove data validation START
  Cells.Select
  With Selection.Validation
      .Delete
      .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
      :=xlBetween
      .IgnoreBlank = True
      .InCellDropdown = True
      .InputTitle = ""
      .ErrorTitle = ""
      .InputMessage = ""
      .ErrorMessage = ""
      .ShowInput = True
      .ShowError = True
  End With
  'To remove data validation END

  wrkbk.Activate
  wrkbk.Sheets("Sheet1").Select

  'Filter Column Price Calculator Status with those that Require Review from Pricing START

  Dim p As Integer, rngData As Range
  Set rngData = Range("A1").CurrentRegion
  p = Application.WorksheetFunction.Match("Price Calculator Status", Range("A1:AZ1"), 0)

  rngData.AutoFilter Field:=p, Criteria1:="=Completed - Requires Review from Pricing"

  'Filter Column Price Calculator Status with those that Require Review from Pricing END

  'Copy the Status Definitions tab to the new worksheet START

  sourceBk.Sheets("2. Status Definitions").Copy _
  after:=ActiveWorkbook.Sheets("Sheet1")

  'Copy the Status Definitions tab to the new worksheet END

  wrkbk.Sheets("Sheet1").Select
  Range("A5").Select

  'Save to Desktop Directory as DOD folder name - Compatible for any user who runs the macro START

  Dim uName As String: uName = Environ("Username")

  fpath1 = "C:\Users\" & uName & "\Desktop\DOD"
  fpath2 = "C:\Users\" & uName & "\Desktop\DOD\Change Status Request Report"
  fpath3 = "C:\Users\" & uName & "\Desktop\DOD\Change Status Request Report\Commercial View"

  If Dir(fpath1, vbDirectory) = vbNullString Then MkDir fpath1
  If Dir(fpath2, vbDirectory) = vbNullString Then MkDir fpath2
  If Dir(fpath3, vbDirectory) = vbNullString Then MkDir fpath3
  ActiveWorkbook.SaveAs (fpath3 & "\Internal Change Status Request Report - Commercial View - " & Format(Now, "yyyy-mm-dd"))
  ActiveWorkbook.Close

  'Save to Desktop Directory as DOD folder name - Compatible for any user who runs the macro END

  'Return back to Overall CR Tracker and filter out Approved and Cancelled CRs START

  Dim s, f, g As Integer, rngData2, rngData5, rngData6 As Range
  Set rngData2 = Range("A1").CurrentRegion
  s = Application.WorksheetFunction.Match("Current State", Range("A1:AZ1"), 0)

  rngData2.AutoFilter Field:=s, Criteria1:=Array( _
  "Detailed Impact Assessment", "Draft – Yet to be Tabled at CCCM", _
  "Initial Impact Assessment", "New", "On Hold", "Pending Approval - Execution", _
  "Pending Approval - IIA"), Operator:=xlFilterValues

  Set rngData5 = Range("B1").CurrentRegion
  f = Application.WorksheetFunction.Match("PCR No.", Range("A1:AZ1"), 0)
  Set rngData6 = Range("C1").CurrentRegion
  g = Application.WorksheetFunction.Match("Accn. ID", Range("A1:AZ1"), 0)

  ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Clear
  **ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
  f, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  xlSortNormal**
  ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
  g, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  xlSortNormal
  With ActiveWorkbook.Worksheets("3. PMO Internal View").Sort
    .SetRange Range("A1:X2000")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

  'Return back to Overall CR Tracker and filter out Approved and Cancelled CRs END
End Sub

Answer 1

The Key parameter of the Sort should have a range or a cell address. Your f is defined as f = Application.WorksheetFunction.Match() which returns a number.

You should have something like Set f = Range("A1") or f = "A1" . Excel will use the column that contains the specified cell.

EDIT 1:

Instead of:

f = Application.WorksheetFunction.Match("PCR No.", Range("A1:AZ1"), 0)
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= f

You should use:

f = Application.WorksheetFunction.Match("PCR No.", Range("A1:AZ1"), 0)
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= Cells(1, f)

Some other comments that come to mind looking at your code:

You variable declarations don't do what you think:

Dim s, f, g As Integer, rngData2, rngData5, rngData6 As Range
'is equivalent to
Dim s As Variant, f As Variant, g As Integer, rngData2 As Variant, rngData5 As Variant, rngData6 As Range

'you should write
Dim s As Integer, f As Integer, g As Integer, rngData2 As Range, rngData5 As Range, rngData6 As Range

You paste too much code. When I saw it, I just skimmed through it and I was lucky I saw the problem. I would usually skip questions like this. You should try to write a function as short as possible that reproduces the same problem. This helps you for two reasons: it's more likely that someone will read it and give you a solution, and it's more likely that you figure it out on your own during the process of reducing the problem. I often start writing questions here, but I don't post them because just thinking about how to write it so you can understand it, makes me understand it.

Mark the answers that help you as answers. I noticed that you never do that, and many people like to help others in exchange for that little gratifying check mark. If you are the guy that doesn't gratify, people don't help you.

EDIT 2:

I think this is what you need (this time I tested it):

  Dim f As Integer, g As Integer, Sh As Worksheet
  Set Sh = Sheets("3. PMO Internal View")
  f = WorksheetFunction.Match("PCR No.", Sh.Range("A1:AZ1"), 0)
  g = WorksheetFunction.Match("Accn. ID", Sh.Range("A1:AZ1"), 0)
  Sh.Range("A1:X2000").Sort Key1:=Sh.Cells(1, f), Order1:=xlAscending, Key2:=Sh.Cells(1, g), Order2:=xlAscending

Notice that I always use the Sh sheet to specify the sheet the Range and the Cells properties refer to. This allows you to use this function regardless of the active sheet. Using Cells(...) or Range(...) without specifying the sheet defaults to the active sheet, and forces you to activate the sheet you want to sort before sorting it.