Good evening. I am developing a subroutine for a project whereby the user is able to upload specific data from a separate workbook into the master. The routine will search through the chosen excel file for specific column headers and only copy/paste those desired columns to the master sheet. This is my first coding project and I think I have the process mostly sorted, however there is one bit of functionality that is eluding me: The specific column titles are moderately similar no matter the workbook, except they may vary between full name and abbreviation. For example the title of the column may be “AZM” or it may be “Azimuth”. Alternatively one column title may be “N/S”, “Northing” or “NS”. There will never be multiple of these titles, just the one in the format that the workbook creator decided to go with.
My current code does not currently account for that:
Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim wb As Workbook Dim filename As String, colName As String Dim LRow As Long, LCol As Long Dim pColName As String, MyHead(1 To 8) As String Dim sCell As Range, PRng As Range Dim col As Long, pCol As Long MsgBox "Ensure plan includes MD/INC/AZM/TVD/NS/EW/VS/DLS" With Application.FileDialog(msoFileDialogOpen) 'Open file explorer .AllowMultiSelect = False 'Only allow one file to be chosen .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1 'Limit selection options to excel files If .Show Then filename = .SelectedItems(1) 'Assign file path to variable filename Set wb = Workbooks.Open(filename:=filename) 'Set selected Excel file to variable wb MyHead(1) = "MD" MyHead(2) = "Inc" MyHead(3) = "Azimuth" MyHead(4) = "TVD" MyHead(5) = "N/S" MyHead(6) = "E/W" MyHead(7) = "VS" MyHead(8) = "DLS" If Not IsEmpty(ThisWorkbook.Worksheets("5D-Lite").Range("M33")) Then LRow = Cells(Rows.Count, 13).End(xlUp).Row 'Find the last row of data in column M from previous plan LCol = Cells(LRow, Columns.Count).End(xlToLeft).Column 'Find the last column of data in the last row ThisWorkbook.Worksheets("5D-Lite").Range("M33:" & Col_Letter(LCol) & LRow).ClearContents 'Clear the contents of the range determined by the Last functions End If With wb.Worksheets(1) For i = LBound(MyHead) To UBound(MyHead) Set sCell = .Range("A1:R50").Find(What:=MyHead(i), LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False) 'Search for the desired directional plan items in column headers If Not sCell Is Nothing Then col = sCell.Column 'Located item's column number pCol = i 12 'Column number in master workbook to paste in colName = Split(.Cells(, col).Address, "$")(1) 'Located item's column letter pColName = Split(.Cells(, pCol).Address, "$")(1) 'Column letter in master workbook to paste in LRow = FindLastNumeric() 'Find the final row with numeric data Set PRng = .Range(sCell.Address & ":" & colName & LRow) 'Set total data range of desired column wb.Activate wb.Worksheets(1).Range(PRng.Address).Copy ThisWorkbook.Worksheets("5D-Lite").Range(pColName & "32") 'Copy contents of selected file to the 5D sheet End If Next Range("M32:T" & LRow 33).NumberFormat = "0.00" 'Assigns numeric formatting to the pasted data range wb.Close SaveChanges:=False Set wb = Nothing End With Else MsgBox "No Plan Selected" End If End With Application.ScreenUpdating = True End Sub
Is there any way to modify the .Find function or the MyHead(i) variables to account for multiple possible variations on the same header name? Thanks for any ideas.