User Tools

Site Tools


microsoft_excel:macros:files:read_file

Microsoft Excel - Macros - Files - Read File

    Dim fileToOpen As Variant
    Dim fileToOpen_name As String
    Dim FileParts() As String
    Dim lastrow_InputFile As Long
    Dim count_InputFile As Double
    Dim count_Test1 As Double
    Dim lastrow_Test1 As Long
 
    ' Ask user for a file to load.
    fileToOpen = Application.GetOpenFilename("Excel files (*.xls; *.xlsx; *.csv),*.xls; *.xlsx; *.csv", , "Select file")
    If fileToOpen = False Then
        MsgBox "No file selected.  No data copied across to the Test sheet."
        Exit Sub
    End If
 
    FileParts() = Split(fileToOpen, Application.PathSeparator)
    fileToOpen_name = FileParts(UBound(FileParts))
 
 
    ' Update StatusBar.
    Application.StatusBar = "Importing file..." & fileToOpen_name
 
 
    ' Start of copying columns across.
    With Workbooks.Open(fileToOpen)
 
        With .Sheets(1)
 
            ' Control to check that the file is in the usual format.
            If .Range("A2") Like "???????" Then
            Else
 
                If ctrl_close_erroneous_files = True Then
                    ' Close the file.
                    Application.DisplayAlerts = False
                    Workbooks(fileToOpen_name).Close
                    Application.DisplayAlerts = True
                End If
 
                MsgBox "The file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across."
                Exit Sub
            End If
 
            ' Control to check that the file is in the usual format.
            If .Range("I2") Like "????" Then
            Else
                If ctrl_close_erroneous_files = True Then
                    ' Close the file.
                    Application.DisplayAlerts = False
                    Workbooks(fileToOpen_name).Close
                    Application.DisplayAlerts = True
                End If
 
                MsgBox "The file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across"
                Exit Sub
            End If
 
 
            ' Control to check that the file is in the usual format.
            If WorksheetFunction.CountA(.Range("A1:X1")) = 24 Then
            Else
                If ctrl_close_erroneous_files = True Then
                    ' Close the file.
                    Application.DisplayAlerts = False
                    Workbooks(fileToOpen_name).Close
                    Application.DisplayAlerts = True
                End If
 
                MsgBox "The file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across"
                Exit Sub
            End If
 
 
            ' Determine how many rows in the input file.
            lastrow_InputFile = .Cells(Rows.Count, 1).End(xlUp).Row
 
 
            ' Copy all columns from file into master sheet where column names match.
            For Each my_from_column In .Range("A1:AD1") ' Range is all columns in input file.
                For Each my_to_column In Workbooks(wb_name).Sheets("Test1").Range("A1:AH1") ' AH is last column containing data from input file.
                    If my_from_column = my_to_column Then .Range(Cells(2, my_from_column.Column), Cells(lastrow_InputFile + 1, my_from_column.Column).End(xlUp)).Copy Workbooks(wb_name).Sheets("Test1").Cells(2, my_to_column.Column)
                Next my_to_column
            Next my_from_column
 
 
            ' Counts the number of cells from the input file that should have been copied across.
            count_InputFile = WorksheetFunction.CountA(.Range("A2:V" & lastrow_InputFile))
 
        End With
 
 
        ' Close the file.
        Application.DisplayAlerts = False
        .Close
        Application.DisplayAlerts = True
 
    End With
 
 
    ' Counts the number of cells in the Test1 sheet that have been copied across.
    With Workbooks(wb_name)
 
        ' Activate the workbook.
        .Activate
 
        With .Sheets("Test1")
 
            ' Activate the sheet.
            .Activate
 
 
            ' Get how many rows of data have been loaded into the sheet.
            lastrow_Test1 = .Cells(Rows.Count, 4).End(xlUp).Row
            ' Prevent line 2 being deleted - as this contains the formulae which need coping down later.
            If lastrow_Test1 < 3 Then
                lastrow_Test1 = 3
            End If
 
 
            ' Count how much data has been loaded into the Test1 sheet.
            count_Test1 = WorksheetFunction.CountA( _
                .Range("D2:D" & lastrow_Test1), _
                .Range("F2:I" & lastrow_Test1), _
                .Range("O2:O" & lastrow_Test1), _
                .Range("S2:AH" & lastrow_Test1))
 
 
            ' Select A1.
            ScrollTo ActiveSheet.name, "A1"
 
        End With
 
    End With
 
 
    ' Control to ensure that the number of cells copied across matches those in the originating file.
    If count_Test1 <> count_InputFile Then
        Message "The number of cells copied from the input file does not equal the number of cells copied to the Sheet1 worksheet. Please manually copy them across."
        Exit Sub
    End If
 
 
    ' Clear all objects.
    Set my_from_column = Nothing
    Set my_to_column = Nothing    
 
microsoft_excel/macros/files/read_file.txt · Last modified: 2021/08/04 15:49 by peter

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki