(Solved) – Object variable or With block variable not set (Error 91) randomly?


The error pops up in this line MOnachbar = FindMO_1.Offset(, off), it seems to almost happen randomly, which I now is not true.
Below is my code. I have run it a few times with different Ranges and it showed no errors. I have about 5000 rows x && columns I need to loop through, here IÄm testing it out for ony one particular row.

Sub test_array()

    'On Error Resume Next
    Application.ScreenUpdating = False
    Dim StartTime As Double
    Dim TimeTaken As Double
    StartTime = Timer
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim myRange As Range
    Dim sArr As Variant
    Dim MORange As Range
    Dim i As Long
    Dim j As Long
    Set MORange = wb.Worksheets("INPUT_WIND").Range("C2:BP2")
    Set myRange = wb.Worksheets("INPUT_WIND").Range("C950:BP950")
    Dim MO As String
    Dim off As Long
    Dim WeaMat As Range
    Set WeaMat = Workbooks.Open("C:UsersNikhil.srivatsaDesktopWeaMat").Worksheets(1).Range("A:A")
    Dim FindMO_1 As Range
    Dim MOnachbar As String
    Dim FindMO_2 As Range
    Dim MOcol As Long
    Dim Vneu As Long
    Dim desRange As Range 'destination range
    Dim ZeitStempel As String
    Dim FINORange As Range
    Dim FINDZeitStempel As Range
    Dim VFINO As Long
    Dim DateRange As Range
    Set DateRange = wb.Worksheets("INPUT_WIND").Range("B3:B950")
    Set FINORange = Workbooks.Open("C:UsersNikhil.srivatsaDesktopFINO raw-010119-310819").Worksheets(1).Range("A:A") 'öffnet FINO Datei und legt die SuchRange fest
    wb.Sheets.Add(after:=wb.Worksheets("INPUT_WIND")).Name = "Ersetzt" ' create new sheet
    Set desRange = wb.Worksheets("Ersetzt").Range("C950:BP950") 'Range im neuen Sheet

    DateRange.Copy wb.Worksheets("Ersetzt").Range("B3:B950") 'Dates und MOs rüberkopieren
    MORange.Copy wb.Worksheets("Ersetzt").Range("C2:BP2") 'Dates und MOs rüberkopieren
    sArr = myRange.Value 'Creates Array of All cells

    For i = LBound(sArr, 1) To UBound(sArr, 1) 'Rows

        For j = LBound(sArr, 2) To UBound(sArr, 2) 'Columns

            If sArr(i, j) <= 0 Or IsEmpty(sArr) = True Then

                off = 1

                Do While off <= 5
                    MO = MORange.Cells(1, j)
                    Debug.Print MO
                    Set FindMO_1 = WeaMat.Find(MO, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'Lookup MO in WEA MAtrix
             MOnachbar = FindMO_1.Offset(, off)
'                   Debug.Print MOnachbar
                    Set FindMO_2 = MORange.Find(MOnachbar, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'lookup MONachbar in INPUT_WIND

                    MOcol = FindMO_2.Column - 2 'column Index für sArr
                    Vneu = sArr(i, MOcol)
                    Debug.Print Vneu

                    If Vneu > 0 And IsEmpty(Vneu) = False Then
                        sArr(i, j) = Vneu 'array value wurde ersetzt
                        desRange.Cells(i, j).AddComment.Text "Ersetzt durch" & " " & MOnachbar 'Kommentar
                        desRange.Cells(i, j).Font.Bold = True 'Bold font
                    Exit Do

                End If

                off = off   1

                If off > 5 Then 'durch FINO daten ersetzen da mehr als 5 umliegende Anlagen entweder Blank oder 0 sind

                    ZeitStempel = myRange.Cells(i, j).Offset(, -j) 'als String / Text
'               Debug.Print ZeitStempel

                Set FINDZetiStempel = FINORange.Find(CDate(ZeitStempel), lookat:=xlWhole, MatchCase:=False, SearchFormat:=True) 'Cdate String ins Date umwandeln
                If Not FINDZeitStempel Is Nothing Then

                    VFINO = FINDZeitStempel.Offset(, 1) 'FINO Wert
                    sArr(i, j) = VFINO
                    desRange.Cells(i, j).AddComment.Text "Ersetzt durch" & " " & "FINO" 'Kommentar
                    desRange.Cells(i, j).Font.Bold = True 'Bold font
                    Exit Do
                    'Debug.Print "Zeitstempel nicht gefunden" & " " & ZeitStempel
                    ErrCnt = ErrCnt   1
                    Exit Do
                End If

            End If

          End If

       Next j
    Next i

    desRange.Value = sArr

'   wb.Worksheets("Ersetzt").Range("C2").Select

    Workbooks("WeaMat").Close False 'close WeaMat without saving
    Workbooks("FINO raw-010119-310819").Close False 'close FINO datei ohne sie zu spiechern
    Application.Calculation = xlCalculationAutomatic
    TimeTaken = Round((Timer - StartTime) / 86400, 2)
    Debug.Print TimeTaken
    If ErrCnt <> 0 Then

        MsgBox "fertig in" & " " & TimeTaken & " " & "Sekunden" & vbCrLf & "einige FINO Zeitstempeln wurden nicht gefunden"

        MsgBox "fertig in" & " " & TimeTaken & " " & "Sekunden"
    End If
    Application.ScreenUpdating = True

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *