VBA is saying "sub or function not defined" and highlighting the statement that should def-CodePudding

I am trying to take a single cell of data from specific files in a very large folder. I currently have this:

Sub ExtractDataToDifferentSheets()
    On Error GoTo HandleError
    Application.ScreenUpdating = False
    Dim rowNumber As Integer
    rowNumber = Worksheets("sheet1").UsedRange.rows.Count

    For dRow = 2 To rowNumber
        Dim NG As String
        Dim Lot As String
        NG = Application.Workbooks(1).ActiveSheet.Cells(dRow, 1)
        Lot = Application.Workbooks(1).ActiveSheet.Cells(dRow, 2)
        Dim objectFlieSys As Object
        'Dim objectGetFile As Object
        Dim file As Object
        Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
        Set file = objectFlieSys.GetFile(StringFormat("C:\Users\mmccarthy\Box\QC-QA\SOPS Quality System\Quality logs\Ingredient Release Forms Records\2022 INGREDIENT RELEASE FORM\{0}_{1}.xlsx", NG, Lot))       ' The folder location of the source files.
        Application.Workbooks(1).ActiveSheet.Cells(dRow, 7) = _
               file.Worksheets("Sheet1").Cells(7, 7)
        file.Close False
        Set file = Nothing
    Next
HandleError:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

I don't have much VBA experience, I was working from the following example:

Sub ExtractDataToDifferentSheets()
    On Error GoTo HandleError
    Application.ScreenUpdating = False
    Dim rowNumber As Integer
    rowNumber = Worksheets("sheet1").UsedRange.rows.Count

    For dRow = 2 To rowNumber
        Dim NG As String
        Dim Lot As String
        NG = Application.Workbooks(1).ActiveSheet.Cells(dRow, 1)
        Lot = Application.Workbooks(1).ActiveSheet.Cells(dRow, 2)
        Dim objectFlieSys As Object
        'Dim objectGetFile As Object
        Dim file As Object
        Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
        Set file = objectFlieSys.GetFile(StringFormat("C:...\2022 INGREDIENT RELEASE FORM\{0}_{1}.xlsx", NG, Lot))       ' The folder location of the source files.
        Application.Workbooks(1).ActiveSheet.Cells(dRow, 7) = _
               file.Worksheets("Sheet1").Cells(7, 7)
        file.Close False
        Set file = Nothing
    Next
HandleError:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

I know it's not the best example to work from, but originally I intended on extracting data from all files in the folder but this took wayyyyyyyyy too long so I limited it to the ones I need. When I wrote the other script to extract the same info from every file in the folder, it ran but the system crashed and I had not saved so I lost all my code.

What is especially confusing is it highlights the first line of code when it throws the error. I get the impression that it is telling me the sub I am trying to define is not defined. That would be silly. Is there just a typo somewhere else in my code that i can't find? I have no idea why the previous code ran when this code is throwing errors immediately. this seems to be the most relevant question I could find on stack overflow, but I can't find 'create' that the answer references.

Please help or I will spend all weekend manually copying data for this incredibly easy task. :(

CodePudding user response：

Highly recommended to turn on Option Explicit when writing your marco. (Found in VBA->Tools->Editor Tab->Require Variable Declaration Ticked).

It will make you define (Dim) your strings, variables, workbooks, sheets names etc.

I would check that "sheet1" is not meant to be a capital S "Sheet1"

Alternativly, change ("sheet1") to just (1) would mark the first sheet in that workbook

Eg. rowNumber = Worksheets("sheet1").UsedRange.rows.Count

would become

rowNumber = Worksheets(1).UsedRange.rows.Count

CodePudding user response：

Import Data From Closed Workbooks

Option Explicit

Sub ImportData()
    Dim IsSuccess As Boolean
    On Error GoTo ClearError
        
    ' Define constants.
    
    Const SOURCE_SUBFOLDER_PATH As String _
        = "Box\QC-QA\SOPS Quality System\Quality logs" _
        & "\Ingredient Release Forms Records\2022 INGREDIENT RELEASE FORM"
    Const SOURCE_FILE_EXTENSION As String = ".xlsx"
    Const NG_LOT_DELIMITER As String = "_"
    
    ' Build the Source folder path.
    
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim SourceFolderPath As String: SourceFolderPath _
        = fso.BuildPath(Environ("USERPROFILE"), SOURCE_SUBFOLDER_PATH)
    If Not fso.FolderExists(SourceFolderPath) Then
        MsgBox "The folder '" & SourceFolderPath & "' doesn't exist.", _
            vbExclamation
        Exit Sub
    End If
    
    ' Destination
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Sheet1")
    Dim dlRow As Long: dlRow = dws.UsedRange.Rows.Count
    
    ' Copy.
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim SourceFileName As String
    Dim SourceFilePath As String
    Dim NG As String
    Dim Lot As String
    Dim dRow As Long

    For dRow = 2 To dlRow
        ' Build the Source file path.
        NG = CStr(dws.Cells(dRow, "A").Value)
        Lot = CStr(dws.Cells(dRow, "B").Value)
        SourceFileName = NG & NG_LOT_DELIMITER & Lot & SOURCE_FILE_EXTENSION
        SourceFilePath = fso.BuildPath(SourceFolderPath, SourceFileName)
        If fso.FileExists(SourceFilePath) Then ' file found
            ' Open, copy and close.
            Set swb = Workbooks.Open(SourceFilePath, True, True)
            Set sws = swb.Worksheets("Sheet1")
            dws.Cells(dRow, "G").Value = sws.Range("G7").Value
            swb.Close SaveChanges:=False
        Else ' file not found
            'dws.Cells(dRow, "G").ClearContents
        End If
    Next dRow

    IsSuccess = True

ProcExit:
    On Error Resume Next
        If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
        If IsSuccess Then
            MsgBox "Data imported.", vbInformation
        Else
            MsgBox "Something went wrong.", vbCritical
        End If
    On Error GoTo 0
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & Err.Description
    Resume ProcExit
End Sub