Search code examples
excelvba

I get an error 1004 when assigning an array to a range


I got the titled error in this line

wsDest.Cells(DestRow, "H").Offset(0, PasteColumn - 1).Value = CopyValues(1, PasteColumn)

The whole code

Sub CopyDataFromFiles()
    Dim SourceFolder As String
    Dim FileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim LastRow As Long
    Dim FoundRow As Range
    Dim CopyRange As Range
    Dim DestRow As Variant ' Use variant to handle potential errors
    Dim EconomicValue As String
    Dim NumberInFileName As String
    Dim CopyValues As Variant
    Dim PasteColumn As Long
    
    ' Turn off screen updating and alerts
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Set the source folder path
    SourceFolder = "\\dms\divs\riskoper\Shared Documents\MORisk\Shared_Folder\IRRBB\DV01\2024-03-31\Flat without EV Spread\Assets\"
    
    ' Set the destination worksheet
    Set wsDest = ThisWorkbook.Sheets(1) ' Adjust sheet index or name as needed
    
    ' Loop through each file in the folder
    FileName = Dir(SourceFolder & "*.xlsx")
    Do While FileName <> ""
        ' Extract number from file name (assuming file names are in the format "123.xlsx")
        NumberInFileName = Left(FileName, InStr(FileName, ".") - 1)
        
        ' Open the source workbook
        Set wbSource = Workbooks.Open(SourceFolder & FileName)
        If Not wbSource Is Nothing Then
            ' Set the source worksheet
            Set wsSource = wbSource.Sheets(1) ' Assuming data is in the first sheet
            
            ' Find "Economic Value" in column A
            EconomicValue = "Economic Value"
            Set FoundRow = wsSource.Columns("A:A").Find(What:=EconomicValue, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not FoundRow Is Nothing Then
                ' Determine the last column with data in the source worksheet
                LastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
                Set CopyRange = wsSource.Range(wsSource.Cells(FoundRow.Row, "B"), wsSource.Cells(FoundRow.Row, "GO"))
                
                ' Read values from CopyRange into CopyValues array
                CopyValues = CopyRange.Value
                
                ' Find matching number in column A of destination worksheet using XLookup
                On Error Resume Next ' Continue execution if XLookup fails to find a match
                DestRow = Application.WorksheetFunction.XLookup(NumberInFileName, wsDest.Columns("A:A"), wsDest.Columns("A:A"), , 0, 2)
                On Error GoTo 0 ' Turn off error handling
                
                If Not IsError(DestRow) Then
                    ' Paste each column of CopyValues into the destination worksheet starting from column H (8th column)
                    For PasteColumn = LBound(CopyValues, 2) To UBound(CopyValues, 2)
                        wsDest.Cells(DestRow, "H").Offset(0, PasteColumn - 1).Value = CopyValues(1, PasteColumn)
                    Next PasteColumn
                    
                    Application.CutCopyMode = False ' Clear clipboard
                Else
                    MsgBox "No match found for " & NumberInFileName & " in destination worksheet."
                End If
            Else
                MsgBox "No match found for 'Economic Value' in " & FileName
            End If
            
            ' Close the source workbook without saving changes
            wbSource.Close SaveChanges:=False
        Else
            MsgBox "Failed to open workbook: " & FileName
        End If
        
        ' Get the next file
        FileName = Dir
    Loop
    
    ' Restore screen updating and alerts
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Data copied successfully."
End Sub

can someone help me?

I am trying to open every file in this folder https://dms/divs/riskoper/Shared Documents/MORisk/Shared_Folder/IRRBB/DV01/2024-03-31/Flat without EV Spread/Assets then Look at column A and find Economic Value then take the whole row copy it then match it on my current spread sheet with the right row and paste it in G cell and forth. Now the matching will happen as follows find the name of the file you open and match the left parts of the name with the left parts of what you look in column A of my current sheet for example 3_IAM to Alpha Bank Cyprus with the right formula match the 3 with the 3.xlsx which is the name of the folder


Solution

  • Your problem lays (very likely) in the following statements:

    On Error Resume Next
    DestRow = Application.WorksheetFunction.XLookup(NumberInFileName, wsDest.Columns("A:A"), wsDest.Columns("A:A"), , 0, 2)
    On Error GoTo 0
    If Not IsError(DestRow) Then
    

    WorksheetFunction.Xlookup will return the default value (the 5th parameter) when nothing is found. If this parameter is empty (like in your code), it will throw a runtime error (1004 - Unable to get the XLookup property...)

    Now you enclose the statement with an error handler. The statement raises an error - that is ignored because of the error handler. The statement does not return an error, DestRow will remain untouched.

    So in case that the value is not found, DestRow is empty. You declared it as Variant, and the default value for Variant is empty. Therefore the next statement If Not isError(DestRow) Then will always be True and the code will hit the statement wsDest.Cells(DestRow, "H")... - which will of course fail - empty is not a valid value for the row number.


    There are two ways to fix your code:
    Change the If-statement and check if DestRow is filled:

    If Not IsEmpty(DestRow) Then
    

    Or use Application.XLookup instead. The difference is that this version doesn't throw a runtime error, it returns an error value (see https://stackoverflow.com/a/66223303/7599798). Using that, you don't need to use the error handler (because no error occurs). Now DestRow will contain an error value when nothing was found:

    DestRow = Application.XLookup(NumberInFileName, wsDest.Columns("A:A"), wsDest.Columns("A:A"), , 0, 2)
    If Not IsError(DestRow) Then