CODEWITHSUNDEEP
vbaexcel
FrenchConnections
FrenchConnections

Reputation: 391

Object defined error while looping through worksheets

I have a project I am working on that entails looping through a series of worksheets, each of which is named after a series of values in a separate sheet. I then perform some functions on each sheet, adding a formula to the next empty column. However, my code is erroring out at this line:

Worksheets(Name).Range(.Cells(2, LastColumn + 1)).Formula = "=F2"

The specific error is

"Application-defined or Object-defined error"

and I'm not sure why this is occurring. I've switched up the way I reference the worksheets, moving around the With-blocks etc. Note that this is just a Sub where I've been testing out different components of the full macro. Any help on this error or what I'm doing wrong would be appreciated! 

Sub Test()
    Dim ws2 As Worksheet
    Dim wb As Workbook
    Dim LastRow As Long, LastColumn As Long
    Dim LastRow2 As Long
    Dim Name As Variant, SheetR As Variant

    Set wb = ActiveWorkbook
    Set ws2 = wb.Sheets("Comm")

    LastRow2 = 6

    'sort each sheet on date descending
    With wb
        SheetR = ws2.Range("A3:A" & (LastRow2 + 2))
        For Each Name In SheetR
            LastColumn = 0
            LastRow = 0
            With Worksheets(Name)
                Worksheets(Name).Rows("1:1").AutoFilter
                Worksheets(Name).AutoFilter.Sort.SortFields.Add Key:=Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With Worksheets(Name).AutoFilter.Sort
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
                LastColumn = Worksheets(Name).Cells(1, Columns.Count).End(xlToLeft).Column
                LastRow = Worksheets(Name).Cells(Rows.Count, 1).End(xlUp).Row
                If LastRow = 1 Then
                ElseIf LastRow = 2 Then
                ElseIf LastRow = 3 Then
                ElseIf LastRow = 4 Then
                ElseIf LastRow > 4 Then
                    'The error is occurring at this next line
                    Worksheets(Name).Range(.Cells(2, LastColumn + 1)).Formula = "=F2"
                    Worksheets(Name).Range(.Cells(3, LastColumn + 1)).Formula = "=F3+O2"
                    Worksheets(Name).Range(.Cells(3, LastColumn + 1)).Select
                    Selection.AutoFill Destination:=Sheets(CStr(Name)).Range(.Cells(4, LastColumn + 1), .Cells(LastRow, LastColumn + 1)), Type:=xlFillDefault
                Else
                End If
            End With
        Next Name
    End With

End Sub

Upvotes: 1

Views: 44

Answers (2)

Cyril
Cyril

Reputation: 6829

Look at my annotation.

Sub Test()
    Dim ws2 As Worksheet, wb As Workbook, LastRow As Long, LastColumn As Long, LastRow2 As Long, Name As Variant, SheetR As Variant
    Set wb = ActiveWorkbook
    Set ws2 = wb.Sheets("Comm")
    LastRow2 = 6
    'sort each sheet on date descending
    SheetR = ws2.Range("A3:A" & (LastRow2 + 2))
    For Each Name In SheetR
        LastColumn = 0
        LastRow = 0
        With Worksheets(Name)
            .Rows("1:1").AutoFilter
            .AutoFilter.Sort.SortFields.Add Key:=.Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal  'Added "." before the Key range
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Added "." before Columns.Count
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Added "." before Rows.Count
            If LastRow = 1 Then
            ElseIf LastRow = 2 Then
            ElseIf LastRow = 3 Then
            ElseIf LastRow = 4 Then
            ElseIf LastRow > 4 Then
                'The error is occurring at this next line
            .Cells(2, LastColumn + 1).Formula = "=F2"  'Removed .range() as this is only a single cell being called
            .Cells(3, LastColumn + 1)).Formula = "=F3+O2"  'Removed .range() as this is only a single cell being called
            .Cells(3, LastColumn + 1)).Select  'Removed .range() as this is only a single cell being called
            Selection.AutoFill Destination:=Sheets(CStr(Name)).Range(.Cells(4, LastColumn + 1), .Cells(LastRow, LastColumn + 1)), Type:=xlFillDefault 'Need to check your qualifiers in this line... using source, not destination
            Else
            End If
        End With
    Next Name
End Sub

Edit1: Fixed innapropriate call for range() on a single cell. Props to u/PeterT for calling it out

Upvotes: 2

user4039065
user4039065

Reputation:

You've taken the time to build a With Worksheets(Name) ... End With block but failed to take advantage of it. Additionally, .Range(.Cells(...)) is bad syntax unless you provide two .Cells for a start and stop.

To rewrite your With Worksheets(Name) ... End With block,

...
With Worksheets(Name)
    .Rows("1:1").AutoFilter
    .AutoFilter.Sort.SortFields.Add Key:=.Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    If LastRow = 1 Then
    ElseIf LastRow = 2 Then
    ElseIf LastRow = 3 Then
    ElseIf LastRow = 4 Then
    ElseIf LastRow > 4 Then
        'The error is occurring at this next line
        .Cells(2, LastColumn + 1).Formula = "=F2"
        .Cells(3, LastColumn + 1).Formula = "=F3+O2"
        .Cells(3, LastColumn + 1).AutoFill Destination:=.Range(.Cells(4, LastColumn + 1), .Cells(LastRow, LastColumn + 1)), Type:=xlFillDefault
    Else
    End If
End With
...

Upvotes: 0

Related Questions