'Error 91 with loop identifying row with specific text

I am having issues with an error 91. My code is a loop and is supposed to:

  1. Go into every file listed in Column A and open it
  2. Find a particular text ("Nights") in column B on each file opened
  3. Copy the monthly values for the row listed as "Nights"
  4. Paste them onto the target sheet

The code is hitting the error once I declare my row - exactly at "DataRow = FindDataRow.Row". This statement is in the loop. Can somebody please help me?

Sub GetForecastData()

    Dim Receiver As Workbook
    Dim myfolder As String
    Dim myfile As String
    Dim oFile As Object
    Dim OpenFile As Workbook
    Dim FileCopy As Worksheet
    Dim FilePaste As Worksheet
    Dim FileRange As Range
    Dim LastRow As Integer
    Dim Figure As String
    Dim FindDataRow As Range
    Dim DataRow As Long
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set Receiver = Workbooks("ForecastOccupancyMacro.xlsm")
    Set FilePaste = Receiver.Worksheets("File List")
    LastRow = Range("A1").End(xlDown).Row
    Set FileRange = FilePaste.Range("A2:A" & LastRow)
    myfolder = FilePaste.Range("A1").Value
    
    FilePaste.Range("B2:M50").Clear
    
    
    For Each oFile In FileRange
    
        myfile = Dir(myfolder & "\" & oFile.Value)
        Set OpenFile = Workbooks.Open(myfolder & "\" & oFile.Value)
        
        Set FindDataRow = OpenFile.Worksheets("2022 Monthly Forecast").Range("B:B").Find(What:="Nights", LookIn:=xlValues, LookAt:=xlWhole)
        DataRow = FindDataRow.Row

        MsgBox FindDataRow.Row
        
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("D59").Value
        oFile.Offset(0, 1) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("N59").Value
        oFile.Offset(0, 2) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("X59").Value
        oFile.Offset(0, 3) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("AH59").Value
        oFile.Offset(0, 4) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("AR59").Value
        oFile.Offset(0, 5) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("BB59").Value
        oFile.Offset(0, 6) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("BL59").Value
        oFile.Offset(0, 7) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("BV59").Value
        oFile.Offset(0, 8) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("CF59").Value
        oFile.Offset(0, 9) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("CP59").Value
        oFile.Offset(0, 10) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("CZ59").Value
        oFile.Offset(0, 11) = Figure
        Figure = OpenFile.Worksheets("2022 Monthly Forecast").Range("DJ59").Value
        oFile.Offset(0, 12) = Figure
        
        OpenFile.Close False
        
    Next oFile
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub


Solution 1:[1]

Import Data From Workbooks

Option Explicit

Sub ImportForecastData()
    
    ' Source
    Const sName As String = "2022 Monthly Forecast"
    Const sCriteriaColumn As String = "B"
    Const sCriteria As String = "Nights"
    Const sColumnsList As String = "D,N,X,AH,AR,BB,BL,BV,CF,CP,CZ,DJ"
    Const sColumnsDelimiter As String = ","
    
    ' Destination
    Const dName As String = "File List"
    Const dsFolderPathAddress As String = "A1"
    Const dFirstCellAddress As String = "A2"

    ' Reference the destination workbook.
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    
    ' Determine the source folder path.
    Dim sFolderPath As String: sFolderPath = dws.Range(dsFolderPathAddress)
    If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
    
    ' Write the source columns to an array.
    Dim sColumns() As String: sColumns = Split(sColumnsList, sColumnsDelimiter)
    Dim sUpper As Long: sUpper = UBound(sColumns)
    
    ' Reference the destination lookup column range containing the file names.
    
    Dim drg As Range
    Dim drCount As Long
    
    With dws.Range(dFirstCellAddress)
        Dim dlCell As Range: Set dlCell = .Resize(dws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If dlCell Is Nothing Then Exit Sub ' no data in column range
        drCount = dlCell.Row - .Row + 1
        Set drg = .Resize(drCount)
    End With
    
    Application.ScreenUpdating = False

    ' Clear possible previous destination data (adjacent to the right
    ' of the destination lookup range).
    drg.Offset(, 1).Resize(, sUpper + 1).Clear
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim srIndex As Variant
    Dim sFileString As String
    Dim sFileName As String
    Dim sc As Long
    Dim dCell As Range
    
    ' Loop through the file names.
    For Each dCell In drg.Cells
        ' Attempt to open and reference the source workbook (file).
        sFileString = CStr(dCell.Value)
        If Len(sFileString) > 0 Then ' not a blank cell
            sFileName = Dir(sFolderPath & sFileString)
            If Len(sFileName) > 0 Then ' file exists
                Set swb = Workbooks.Open(sFolderPath & sFileName)
                ' Attempt to reference the source worksheet.
                On Error Resume Next
                    Set sws = swb.Worksheets(sName)
                On Error GoTo 0
                If Not sws Is Nothing Then ' worksheet exists
                    ' Attempt to calculate the source criteria row index.
                    srIndex = Application.Match(sCriteria, _
                        sws.Columns(sCriteriaColumn), 0)
                    If IsNumeric(srIndex) Then ' criteria found
                        ' Write the data.
                        For sc = 0 To sUpper
                            dCell.Offset(, sc + 1).Value _
                                = sws.Cells(srIndex, sColumns(sc))
                        Next sc
                    'Else ' criteria not found; do nothing
                    End If
                    Set sws = Nothing
                'Else ' worksheet doesn't exist; do nothing
                End If
                ' Close the source workbook.
                swb.Close SaveChanges:=False
                Set swb = Nothing
            'Else ' file doesn't exist; do nothing
            End If
        'Else ' blank cell; do nothing
        End If
    Next dCell
    
    ' Save the destination workbook.
    'dwb.Save
    
    Application.ScreenUpdating = True

    MsgBox "Forecast data imported.", vbInformation

End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 VBasic2008