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 14:49 by peter