Hi all,
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
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
