VBA Sort Macro not working

Question

The sort code is not working anymore. It worked the first time. Then I closed it and opened it and then it gave me an error. (I didn't change anything.) It gave me:

Error 438: Object doesn't support this property or method

On this line:

DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), SortOn:=xlSortOnValues, _
                                     Order:=xlAscending, DataOption:=xlSortNormal`

Snippet of sort code:

    'Alpahebtical order
    DataSheet.Range("A1").Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    FNOrdCol = ActiveCell.Address
    DataWB.DataSheet.Sort.SortFields.Clear
    DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With DataWB.DataSheet.Sort
        .SetRange DataSheet.Cells
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Entire Code:

Sub iGetData()

Dim ValidatorWB As Workbook
Dim PopDetail As Worksheet
Dim DataSheetName As String
Dim DataWB As Workbook
Dim DataSheet As Worksheet
Dim Ret
Dim DWBName As String
Dim FNOrder As String
Dim FNOrdCol As String

Set PopDetail = Worksheets("PopulateWireframe")
Set ValidatorWB = Workbooks(ActiveWorkbook.Name)
DataSheetName = Range("F18").Value
FNOrder = Range("F33").Value

Application.ScreenUpdating = False

'Open data file
Ret = IsWorkBookOpen(PopDetail.Range("C18").Value)
If Ret = False Then

Workbooks.Open PopDetail.Range("C18").Value
DataFileName = ActiveWorkbook.Name
Set DataWB = Workbooks(DataFileName)
Set DataSheet = Worksheets(DataSheetName)

Dim FilterColumn As String
Dim FilterCriteria As String
Dim ColumnNumber As Integer

'Set filter
With DataSheet
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
End With

ValidatorWB.Activate
PopDetail.Activate

For x = 21 To 30

If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then

    FilterColumn = PopDetail.Range("E" & x).Value
    FilterCriteria = PopDetail.Range("F" & x).Value

    DataWB.Activate
    DataSheet.Activate

    DataSheet.Range("A1").Select

    Selection.End(xlToLeft).Select

    ActiveCell.Rows("1:1").EntireRow.Select

    Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

    ColumnNumber = ActiveCell.Column

    DataSheet.AutoFilterMode = False
    DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria

End If

    ValidatorWB.Activate
    PopDetail.Activate

'x = x + 1

Next x

    DataWB.Activate
    DataSheet.Activate

    'Alpahebtical order
    DataSheet.Range("A1").Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    FNOrdCol = ActiveCell.Address
    DataWB.DataSheet.Sort.SortFields.Clear
    DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With DataWB.DataSheet.Sort
        .SetRange DataSheet.Cells
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Copy data
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    'Paste data to validator
    ValidatorWB.Activate
    ValidatorWB.Sheets.Add().Name = "ValidatorData"
    ActiveCell.Offset(3, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15
    Application.CutCopyMode = False

'DataWB.Close savechanges:=False
If DataWB.Windows(1).Visible = True Then
DataWB.Windows(1).Visible = False
End If

Application.ScreenUpdating = True

PopDetail.Activate

Else

DWBName = GetFilenameFromPath(PopDetail.Range("C18").Value)
Set DataWB = Workbooks(DWBName)
DataWB.Activate
Set DataSheet = Worksheets(DataSheetName)
DataSheet.Activate
With DataSheet
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
End With

ValidatorWB.Activate
PopDetail.Activate

For x = 21 To 30

If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then

    FilterColumn = PopDetail.Range("E" & x).Value
    FilterCriteria = PopDetail.Range("F" & x).Value

    DataWB.Activate
    DataSheet.Activate

    DataSheet.Range("A1").Select

    Selection.End(xlToLeft).Select

    ActiveCell.Rows("1:1").EntireRow.Select

    Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

    ColumnNumber = ActiveCell.Column

    DataSheet.AutoFilterMode = False
    DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria

End If

    ValidatorWB.Activate
    PopDetail.Activate

'x = x + 1

Next x

    DataWB.Activate
    DataSheet.Activate

    'Alpahebtical order
    DataSheet.Range("A1").Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    FNOrdCol = ActiveCell.Address
    'DataWB.DataSheet.Sort.SortFields.Clear
    DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With DataWB.DataSheet.Sort
        .SetRange DataSheet.Cells
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Copy data
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    'Paste data to validator
    ValidatorWB.Activate
    ValidatorWB.Sheets.Add().Name = "ValidatorData"
    ActiveCell.Offset(3, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15
    Application.CutCopyMode = False

'DataWB.Close savechanges:=False
If DataWB.Windows(1).Visible = True Then
DataWB.Windows(1).Visible = False
End If

Application.ScreenUpdating = True

PopDetail.Activate

End If

End Sub

The *FNOrder* variable is set to `Range("F33").Value` with no regard as to what worksheet Range("F33").Value resides on. See [How to avoid using Select in Excel VBA macros](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) for methods on getting away from relying on select and activate to accomplish your goals. — , Jun 11 '15 at 17:04
It looks like `If Ret = False Then` is not closed off soon enough. If Ret is true then the sort routine is never reached. — , Jun 11 '15 at 17:21
Range("F33").Value is assigning correctly. It's from an excel form which is always the active sheet when running the macro so it's working fine. Thank you for pointing out the Ret = False part. Fixed it. Now it's giving me error 438 for: DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal — Tanzir Rahman, Jun 11 '15 at 17:27

score 0 · Answer 1 · edited Apr 13 '17 at 12:40

If the debugging info shows that the FNOrder variable is correctly assigned, then this shortened version of your sort code should be all that you require.

    debug.print FNOrder & " is the name of the column to be sorted on"
    With DataSheet
        With .Cells(1, 1).CurrentRegion
            .Cells.Sort Key1:=.Columns(Application.Match(FNOrder, .Rows(1), 0)), Order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
            .Cells.Copy
        End With
    End With

If DataSheet has been properly defined, you do not need to specify the parent workbook.

At the end of that code section, the data should be sorted and 'on-the-clipboard'. You still need to add a new worksheet to the ValidatorWB workbook and paste the values.

If that crashes, check the VBE's Immediate window (e.g. Ctrl+G) to see what was reported as being the value of FNOrder.

If you get this running to your satisfaction, I would recommend posting it in Code Review (Excel) for optimization tips.

I get "Object does not support this property or method" on "With DataWB.DataSheet" — Tanzir Rahman, Jun 11 '15 at 17:42
See my revision. Again, what was reported to the VBE's Immediate window and is that value in row 1 of DataSheet? — , Jun 11 '15 at 17:44

score 0 · Answer 2 · answered Jun 11 '15 at 17:48

0

Fixed. I changed DataWB.DataSheet in all references to just ActiveSheet. Thank you for the help.

answered Jun 11 '15 at 17:48

Tanzir Rahman

165
1
2
19

So what you are left with is `Set DataSheet = Worksheets(DataSheetName)` where the parent of `Worksheets(DataSheetName)` is not properly defined. The whole routine could stand a rewrite but the above would be better as `Set DataSheet = DataWB.Worksheets(DataSheetName)` . Why would you have worksheets in different workbooks with the same name? – Jun 11 '15 at 17:53
My macro copies data from multiple workbooks and worksheets and matches it so it gets messy the deeper you dig. This is the first code I wrote in 5 years so there are definitely some inefficiencies. VB isn't very kind either with it's consistency requirements. – Tanzir Rahman Jun 11 '15 at 18:16

VBA Sort Macro not working

2 Answers2

Linked