Search code examples
excelvbams-office

VBA Excel importing new rows to file


I am trying to import rows with new data from the Report.xlsx file to my Workbook.xlsx file, based on column X , which can contain a number or numbers separated by a comma. I only have to import the rows that are not already in my workbook, with 69 cells which can contain numbers and text as well. I want this macro to run automatically on a weekly basis. The program runs without any issue, it evens opens and closes the Report file after executing, but the rows are not imported.

Sub Weekly_Report()
Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
Const NUM_COLS As Long = 69 '69 rows needed to be imported from the Report

Dim Path, Filename, wbReport As Workbook, wsReport As Worksheet, m
Dim wsData As Worksheet, next_blank_row As Long, r As Long, c As Range, rwStart As Long

Path = "C:\Users\Documents\" 'path of the report
Filename = Dir(Path & "Report.xlsx")

Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
next_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row + 1 'next blank row

Do While Filename <> ""

    Set wbReport = Workbooks.Open(Path & Filename) 
    Set wsReport = wbReport.Worksheets(1)          
    rwStart = IIf(HAS_HEADER, 2, 1)
    
    For r = rwStart To wsReport.Cells(Rows.Count, 1).End(xlUp).Row
        
        m = Application.Match(wsReport.Cells(r, 1).Value, wsData.Columns("X"), 0)
        If IsError(m) Then
            m = next_blank_row 'no match - use next blank row and increment
            next_blank_row = next_blank_row + 1
        End If
        wsData.Cells(m, 1).Resize(1, NUM_COLS).Value = wsReport.Cells(r, 1).Resize(1, NUM_COLS).Value
    Next r
    
    wbReport.Close False
    Filename = Dir()
Loop

End Sub

Solution

  • As alternative to MATCH try the Range.Find function.

    Option Explicit
    
    Sub Weekly_Report()
        
        Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
        Const NUM_COLS As Long = 69 '69 rows needed to be imported from the Report
        Const FILENAME = "Report.xlsx"
        Const PATH = "C:\Users\Documents\" 'path of the report
        
        Dim wbReport As Workbook, wsReport As Worksheet, wsData As Worksheet
        Dim next_blank_row As Long, iStartRow As Long, iLastRow As Long, iRow As Long
        Dim sFilename As String
            
        Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
        next_blank_row = wsData.Cells(Rows.Count, "X").End(xlUp).Row + 1 'next blank row
        
        sFilename = PATH & FILENAME
        Debug.Print "Opening ", sFilename
        On Error Resume Next
     
        Set wbReport = Workbooks.Open(sFilename)
        On Error GoTo 0
        If wbReport Is Nothing Then
            MsgBox "Can not open " & sFilename, vbCritical, "ERROR"
            Exit Sub
        End If
            
        Set wsReport = wbReport.Worksheets(1)
        iStartRow = IIf(HAS_HEADER, 2, 1)
        iLastRow = wsReport.Cells(Rows.Count, 1).End(xlUp).Row
            
        Dim s As String, rng As Range, m As Long
        For iRow = iStartRow To iLastRow
            
            s = CStr(wsReport.Cells(iRow, "X").Value)
            Set rng = wsData.Columns("X").Find(s)
            
            If rng Is Nothing Then
                m = next_blank_row 'no match - use next blank row and increment
                next_blank_row = next_blank_row + 1
                Debug.Print iRow, s, "New row " & m
            Else
                m = rng.Row
                Debug.Print iRow, s, "Match row " & m
            End If
            wsData.Cells(m, 1).Resize(1, NUM_COLS).Value = wsReport.Cells(iRow, 1).Resize(1, NUM_COLS).Value
            
        Next
            
        MsgBox wsReport.Name & " scanned from row " & iStartRow & _
               " to " & iLastRow, vbInformation, sFilename
        wbReport.Close False
    
    End Sub