Hi,
Im trying to write an excel VBA code:
Master file is where the file should be uploaded
Master file has row 3 filled with the headers or Column names (examples; destination, round trip distance, so on.....)
the file should be uploaded to this master file by browsing through the computer
the uploading file's row 1 has same headers as row 3 of the master file (should be checked by code)...(examples; destination, round trip distance, so on.....)
if its correct then all the values from each column of the uploading file should be filled in the same name column of the master file this code is for n number of rows
Here is my code, what i am doing wrong
attaching both of my files for your reference
Code
Sub upload_data()
Dim WScopy As Worksheet, WSdest As Worksheet, desWB As Workbook, FileToOpen As Variant, cRow As Long, Lastrow As Long
Dim i As Long, v1 As Variant, fVisRow As Long, lVisRow As Long
Set desWB = ThisWorkbook
Set WSdest = desWB.Sheets(1)
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then Exit Sub
Set OpenBook = Application.Workbooks.Open(FileToOpen)
'Check if column headers match
Dim headerDict As Object
Set headerDict = CreateObject("Scripting.Dictionary")
Dim j As Long
For j = 1 To WSdest.Cells(3, Columns.Count).End(xlToLeft).Column
headerDict.Add Trim(WSdest.Cells(3, j).Value), j
Next j
For j = 1 To OpenBook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
If Not headerDict.exists(Trim(OpenBook.Sheets(1).Cells(1, j).Value)) Then
MsgBox "Column headers do not match"
OpenBook.Close SaveChanges:=False
Exit Sub
End If
Next j
Lastrow = WSdest.Cells(Rows.Count, "A").End(xlUp).Row + 1
For cRow = 2 To OpenBook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To headerDict.Count
v1 = OpenBook.Sheets(1).Cells(cRow, headerDict.Items()(i)).Value
WSdest.Cells(Lastrow, headerDict.Items()(i)).Value = v1
Next i
Lastrow = Lastrow + 1
Next cRow
OpenBook.Close SaveChanges:=False
Set headerDict = Nothing
End Sub
