CODEWITHSUNDEEP
vba
Indradeap Chatterjee
Indradeap Chatterjee

Reputation: 25

How to fix Compile Error: Sub or function not defined in VBA?

This is a code that goes through the cells in column B in sheet2. If it finds a value that is not a date in column B, then it copies it, pastes it another sheet called 'errors' and then deletes that row from Sheet2. Whenever I try to run this, however, I get a 'Compile Error: Sub or function not defined'. I saw some other posts on this, but nothing mentioned there seemed to work for me. 

Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheet("Errors").CountA("A1:A100")

    For Each i In Worksheet("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
        If IsDate(i.Offset(0, 1)) = False Then
            Range(i, i.End(xlToRight)).Copy
            Worksheet("Errors").Range("A1").Offset(x, 0).Paste
            Range(i).EntireRow.Delete
        End If
    Next i
End Sub

Upvotes: 0

Views: 12869

Answers (3)

QHarr
QHarr

Reputation: 84465

There are a few other errors/changes that could be made within the script

  1. Add s to Worksheet
  2. Use Option Explicit at top of code
  3. Application.WorksheetFunction.CountA
  4. Add range as argument to Counta i.e. Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
  5. Ensure correct ranges being worked with by wrapping in With Worksheets("Sheet2")
  6. Determine last row by coming up from bottom of sheet with .Cells(.Rows.Count, "A").End(xlUp).Row, or you could end up looping to bottom of sheet
  7. Correct syntax for delete line: i.EntireRow.Delete
  8. You can put copy paste on one line: .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
  9. Be wary of using End(xlToRight) in cases of potentially ending up at far right of sheet.
  10. Optimize code by switching some things off e.g. prevent repaint by switching off screen-updating during looping
  11. Gather ranges to delete with Union and delete in 1 go or loop backwards to delete

VBA:

Option Explicit
Public Sub removeerrors()
    Dim i As Range, x As Double, loopRange As Range, lastRow As Long, unionRng As Range
    x = Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
    Application.ScreenUpdating = False
    With Worksheets("Sheet2")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set loopRange = .Range("A2:A" & lastRow)
        If lastRow = 1 Then Exit Sub
        For Each i In loopRange
            If Not IsDate(i.Offset(0, 1)) Then
                .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, i)
                Else
                    Set unionRng = i
                End If
            End If
        Next i
    End With
    If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

DisplayName
DisplayName

Reputation: 13386

use fully qualified range references

loop backwards when deleting rows

update target sheet pasting row index

as follows

Option Explicit

Sub removeerrors()
    Dim iRow As Long
    Dim x As Double
    x = Worksheets("Errors").CountA("A1:A100")

    With Worksheets("Sheet2") ' referecne "Sheet2" sheet
        With .Range(.Range("A2"), .Range("A2").End(xlDown))  ' reference referenced sheet range from cell A2 down to next not empty one
            For iRow = .Rows.Count To 1 Step -1 ' loop reference range backwards from its last row up
                If Not IsDate(.Cells(iRow, 2)) Then ' if referenced range cell in column B current row is not a date
                    .Range(.Cells(iRow, 1), .Cells(iRow, 1).End(xlToRight)).Copy Destination:=Worksheets("Errors").Range("A1").Offset(x, 0) ' copy referenced range current row spanning from column A to next not empty column and paste it to sheet "Errors" column A row x
                    x = x + 1 ' update offset
                    .Rows(1).EntireRow.Delete ' delete referenced range current row
                End If
            Next
        End With
    End With
End Sub

Upvotes: 0

Kirszu
Kirszu

Reputation: 364

You just need to change Worksheet to Worksheets with 's' at the end. 

Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheets("Errors").CountA("A1:A100")

    For Each i In Worksheets("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
        If IsDate(i.Offset(0, 1)) = False Then
            Range(i, i.End(xlToRight)).Copy
            Worksheets("Errors").Range("A1").Offset(x, 0).Paste
            Range(i).EntireRow.Delete
        End If
    Next i
End Sub

Upvotes: 0

Related Questions