jardenp
Active Member
- Joined
- May 12, 2009
- Messages
- 373
- Office Version
- 2019
- 2016
- 2013
- 2011
- 2010
- Platform
- Windows
Please see red notes in the code below for the error message. I'm stumped. I copied most of this from another macro that I'm pretty sure works. Please help.
Also, my coding for sorting is basically just a slight improvement on the macro recorder output. If anyone can point out a more concise/elegant way to do this, I'd really appreciate it!
Thanks,
JP in IN
Also, my coding for sorting is basically just a slight improvement on the macro recorder output. If anyone can point out a more concise/elegant way to do this, I'd really appreciate it!
Thanks,
JP in IN
Code:
'Variables Dim MasterListFileName As String
MasterListFileName = "TTrac Log Violations.xlsx"
Dim MasterListSheetName As String
MasterListSheetName = "Violation Master List"
Dim MasterListFileLocation As String
MasterListFileLocation = "C:\Users\XXXX\Desktop\TTrac Log Violations.xlsx"
'**************Other code in between these two sections, but the variables above aren't mentioned****************
'Test if Teletrac Log Violations is open. If not, open it
Dim TestWorkbook As Workbook
Set TestWorkbook = Nothing
On Error Resume Next
Set TestWorkbook = Workbooks(MasterListFileName)
On Error GoTo 0
If TestWorkbook Is Nothing Then
Workbooks.Open Filename:=MasterListFileLocation
Else
Windows(MasterListFileName).Activate
Range("A1").Select
End If
Dim MLWB As Workbook
Dim MLWS As Worksheet
Set MLWB = ActiveWorkbook
Set MLWS = MLWB.Sheets(MasterListSheetName)
'Set the row to paste to (first blank on destination sheet)
Dim AddRow As Long
AddRow = Range("A100000").End(xlUp).Row + 1
'Paste
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Set last row
Dim MLLRow As Long
MLLRow = Range("A10000").End(xlUp).Row
'Extend point formula
Range("E2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Point List'!C[-4]:C[-3],2,FALSE)"
Range("E2").AutoFill Destination:=Range("E2:E" & MLLRow)
'Remove Duplicates
Range("A2").Select
ActiveSheet.Range("$A$1:$E$" & MLLRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlYes
'Sort by Last > First > Date (new to old) > Violation
Range("A2").Select
[COLOR=#ff0000] MLWB.MLWS.sort.SortFields.Clear '*********"Run Time Error 438 Object doesn't support this property or method" ERROR ON THIS LINE************[/COLOR]
MLWB.MLWS.sort.SortFields.Add Key:= _
Range("A2:A" & MLLRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
MLWB.MLWS.sort.SortFields.Add Key:= _
Range("B2:B" & MLLRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
MLWB.MLWS.sort.SortFields.Add Key:= _
Range("C2:C" & MLLRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
MLWB.MLWS.sort.SortFields.Add Key:= _
Range("D2:D" & MLLRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With MLWB.MLWS.sort
.SetRange Range("A1:E" & MLLRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With