I am very new to VBA but have an ambitious goal that you may be able to help with.
I have the code below which is a small part of a larger code from Ron De Bruin importing using ADO method. The code enables opening of a closed workbook and importing data from that workbook into current workbook. This works perfectly only if the columns are set up to match in both workbooks which in my case is not always possible to achieve on all 40 columns of data each time. My import data files always have the first line as a header but the titles are not always consistent for example:
[TABLE="width: 545, align: center"]
<tbody>[TR]
[TD]Employee Number
[/TD]
[TD]Start Date
[/TD]
[TD]Grade
[/TD]
[TD]Current Salary
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]Sometimes is
[/TD]
[TD]Sometimes is
[/TD]
[TD]Sometimes is
[/TD]
[TD]Sometimes is
[/TD]
[/TR]
[TR]
[TD]Staff ID
[/TD]
[TD]Company Start Date
[/TD]
[TD]Company Grade
[/TD]
[TD]Salary
[/TD]
[/TR]
[TR]
[TD]Employee ID
[/TD]
[TD]Group Start Date
[/TD]
[TD]Corporate Grade
[/TD]
[TD]Current Year Salary
[/TD]
[/TR]
[TR]
[TD]Personnel ID
[/TD]
[TD]Date Started
[/TD]
[TD]Current Year Grade
[/TD]
[TD]CY Salary
[/TD]
[/TR]
</tbody>[/TABLE]
1. Is there a method of tweaking the code below so that when the import begins the code finds the different titles of employee number and when a match is found – puts the data into a worksheet named range called Employee_Number in my receiving workbook and then moves on to Start Date, Grade etc. until all the defined columns are completed.
2. Where a match is not found for a column header a message box informing the user to pop up then continuing with the rest of the import
Sub GetData_Example4()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
If FName = False Then
'do nothing
Else
GetData FName, "", "A1:C1", Sheets("Sheet1").Range("A1"), False, False
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
I have the code below which is a small part of a larger code from Ron De Bruin importing using ADO method. The code enables opening of a closed workbook and importing data from that workbook into current workbook. This works perfectly only if the columns are set up to match in both workbooks which in my case is not always possible to achieve on all 40 columns of data each time. My import data files always have the first line as a header but the titles are not always consistent for example:
[TABLE="width: 545, align: center"]
<tbody>[TR]
[TD]Employee Number
[/TD]
[TD]Start Date
[/TD]
[TD]Grade
[/TD]
[TD]Current Salary
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]Sometimes is
[/TD]
[TD]Sometimes is
[/TD]
[TD]Sometimes is
[/TD]
[TD]Sometimes is
[/TD]
[/TR]
[TR]
[TD]Staff ID
[/TD]
[TD]Company Start Date
[/TD]
[TD]Company Grade
[/TD]
[TD]Salary
[/TD]
[/TR]
[TR]
[TD]Employee ID
[/TD]
[TD]Group Start Date
[/TD]
[TD]Corporate Grade
[/TD]
[TD]Current Year Salary
[/TD]
[/TR]
[TR]
[TD]Personnel ID
[/TD]
[TD]Date Started
[/TD]
[TD]Current Year Grade
[/TD]
[TD]CY Salary
[/TD]
[/TR]
</tbody>[/TABLE]
1. Is there a method of tweaking the code below so that when the import begins the code finds the different titles of employee number and when a match is found – puts the data into a worksheet named range called Employee_Number in my receiving workbook and then moves on to Start Date, Grade etc. until all the defined columns are completed.
2. Where a match is not found for a column header a message box informing the user to pop up then continuing with the rest of the import
Sub GetData_Example4()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
If FName = False Then
'do nothing
Else
GetData FName, "", "A1:C1", Sheets("Sheet1").Range("A1"), False, False
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub