Error 438"Object Doesn't Support This Property or Method"

Question

Related to Excel VBA - I have a large dataset and would like to split it by Ratings. For a small dataset the code works perfectly, but for a large dataset (11,000 rows & 20 columns), it loops and either get "Restart Excel program" or a 438 error. Need some help to optimize/correct the code. Using Excel 2013

I tried Cut/paste instead of copy/paste - it does not work

Private Sub SplitData_Click()
    a = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To a
        If Sheets("Sheet1").Cells(i, 2).Value = "AAA" Then
            Sheets("Sheet1").Rows(i).Cut
            Sheets("Sheet2").Activate
            b = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Sheet2").Cells(b + 1, 1).Select
            ActiveSheet.Paste
        End If
        If Sheets("Sheet1").Cells(i, 2).Value = "BBB" Then
            Sheets("Sheet1").Rows(i).Cut
            Sheets("Sheet3").Activate
            c = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Sheet3").Cells(c + 1, 1).Select
            ActiveSheet.Paste
        End If
        If Sheets("Sheet1").Cells(i, 2).Value = "CCC" Then
            Sheets("Sheet1").Rows(i).Cut
            Sheets("Sheet4").Activate
            d = Sheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Sheet4").Cells(d + 1, 1).Select
            ActiveSheet.Paste
        End If
        Sheets("Sheet1").Activate
    Next
    Application.CutCopyMode = False
End Sub

I want to split the large data set into different groups (Sheets) based on the value - AAA, BBB or CCC. I have 10 such value flags.

Error 438 is caused by a late-bound member call that can't be resolved. Fix it by avoiding late binding. `Sheets("Sheet1")` returns an `Object`: any member call chained to it is inherently late-bound, so you get no intellisense/autocompletion, no compile-time validation, and `Option Explicit` (which should be specified at the top of your module, forcing you to explicitly declare all variables you're using) can't save you from a typo. Take that `Object` and cast it to a `Worksheet`, for example: `Dim ws As Worksheet`, `Set ws = Sheets("Sheet1")`. Now the compiler can assist and fix error 438. — Mathieu Guindon, Aug 22 '19 at 17:16

Tim Williams · Answer 1 · 2019-08-22T17:47:13.337

1

Another approach:

Private Sub SplitData_Click()

    Dim a As Long, i As Long, sht As Worksheet, sDest As String

    Set sht = Sheets("Sheet1")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    a = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row

    For i = a To 2 Step -1 'work from bottom up
        sDest = ""
        'need to cut this row?
        Select Case sht.Cells(i, 2).Value
            Case "AAA": sDest = "Sheet2"
            Case "BBB": sDest = "Sheet3"
            Case "CCC": sDest = "Sheet4"
        End Select
        'cut row to relevant sheet
        If Len(sDest) > 0 Then
            sht.Rows(i).Cut Sheets(sDest).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
    Next i

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic

End Sub

NOTE: locating the "cut to" cell using xlUp relies on every previous row in the destination sheet having a value in ColA - if any are empty then rows could get overwritten by the next pasted row.

edited Aug 22 '19 at 17:47

answered Aug 22 '19 at 17:15

Tim Williams

154,628
8
97
125

Thanks a lot Tim, but the solution does not work as expected. I have 9 cases and the row does not move as per the code - Case "AAA": sDest = "Sheet2" Case "AA": sDest = "Sheet3" Case "A": sDest = "Sheet4" Case "BBB": sDest = "Sheet5" Case "BB": sDest = "Sheet6" Case "B": sDest = "Sheet7" Case "CCC": sDest = "Sheet8" Case "HY": sDest = "Sheet9" Case "IG": sDest = "Sheet10" – Francis Aug 26 '19 at 15:57
Exactly how is it misbehaving? – Tim Williams Aug 26 '19 at 16:09
I see the B & CCC in the same sheet – Francis Aug 27 '19 at 22:08

Siddharth Rout · Answer 2 · 2019-08-22T18:46:30.907

Try this. This should be faster as this doesn't involve ANY looping.

Logic

Use Autofilter to Copy the rows across in one go
Clear rows after copying
Delete blank rows in one go using Autofilter

Code

Dim wsInput As Worksheet

Sub SplitData_Click()
    Dim wsOutputA As Worksheet
    Dim wsOutputB As Worksheet
    Dim wsOutputC As Worksheet

    Set wsInput = ThisWorkbook.Sheets("Sheet1")
    Set wsOutputA = ThisWorkbook.Sheets("Sheet2")
    Set wsOutputB = ThisWorkbook.Sheets("Sheet3")
    Set wsOutputC = ThisWorkbook.Sheets("Sheet4")

    Dim lrow As Long
    Dim rng As Range

    With wsInput
        .AutoFilterMode = False

        lrow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rng = .Range("A1:A" & lrow)

        '~~> Filter on AAA
        HandleIt "AAA", rng, wsOutputA

        '~~> Filter on BBB
        HandleIt "BBB", rng, wsOutputB

        '~~> Filter on CCC
        HandleIt "CCC", rng, wsOutputC

        '~~> Filter on blanks
        With rng
            .AutoFilter Field:=1, Criteria1:="="
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        .AutoFilterMode = False
    End With
End Sub

Private Sub HandleIt(AFCrit As String, r As Range, wks As Worksheet)
    Dim OutputRow As Long
    Dim filteredRange As Range

    With r
        .AutoFilter Field:=1, Criteria1:=AFCrit
        Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
    End With

    If Not filteredRange Is Nothing Then
        With wks
            OutputRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            filteredRange.Copy .Rows(OutputRow)
            filteredRange.ClearContents
        End With
    End If

    wsInput.ShowAllData
End Sub

In Action

Note: The above code took 4 seconds on 21k rows x 31 columns data

-I see that the code runs quickly, but I wanted to know what should I change if the criteria column (AAA, BBB, CCC) is the second column not the first? — Francis, Aug 26 '19 at 16:37

score 0 · Answer 3 · answered Aug 22 '19 at 17:11

Please see How to avoid using Select in Excel VBA.

Option Explicit

Private Sub SplitData_Click()
    Dim i As Long

    With Worksheets("Sheet1")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Select Case .Cells(i, 2).Value
            Case "AAA"
                MoveToEndOf .Rows(i), Worksheets("Sheet2")
            Case "BBB"
                MoveToEndOf .Rows(i), Worksheets("Sheet3")
            Case "CCC"
                MoveToEndOf .Rows(i), Worksheets("Sheet4")
            End Select
        Next
    End With
End Sub

Private Sub MoveToEndOf(ByVal what As Range, ByVal where As Worksheet)
    what.Cut where.Cells(where.Rows.Count, 1).End(xlUp).Offset(1, 0)
End Sub

when you `Cut` rows, won't you end up skipping every other row ? — Shai Rado, Aug 22 '19 at 17:16

Darrell H · Answer 4 · 2019-08-27T00:22:44.767

Here is an option without using copy/paste

Private Sub SplitData_Click()
    Dim a As Long
    Dim b As Long
    Dim c As Long
    Dim d As Long
    Dim i As Long

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim ws4 As Worksheet

    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    Set ws4 = ThisWorkbook.Sheets("Sheet4")

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    a = ws1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a

        If ws1.Cells(i, 2).Value = "AAA" Then
            b = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            ws2.Rows(b).Value = ws1.Rows(i).Value

        End If
        If ws1.Cells(i, 2).Value = "BBB" Then
            c = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1
            ws2.Rows(c).Value = ws1.Rows(i).Value
        End If
        If ws1.Cells(i, 2).Value = "CCC" Then
            d = Sheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).Row + 1
            ws2.Rows(d).Value = ws1.Rows(i).Value
        End If

    Next i
    With Application
             .ScreenUpdating = True
             .Calculation = xlCalculationAutomatic
    End With
End Sub

What does “not work” mean? There should be no limit to the number of times the loop could execute. — Darrell H, Aug 26 '19 at 18:40
See edited version where I turned off calculations and screen updating. That should solve the problem as it will calculate the entire worksheet each time it is updated. — Darrell H, Aug 27 '19 at 00:23

Error 438"Object Doesn't Support This Property or Method"

4 Answers4