how to copy data from csv sheet to excel sheet if column header match - excel

Question

Option Explicit
Function GetHeadersDict() As Scripting.Dictionary
' We must activate the Microsoft Scripting Runtime from Tools --References
Dim result As Scripting.Dictionary
Set result = New Scripting.Dictionary
With result
.Add "Name", False
.Add "Mobile", False
.Add "Phone", False
.Add "City", False
.Add "Designation", False
.Add "DOB", False
End With
Set GetHeadersDict = result
End Function
Function FindHeaderRange(ByVal ws As Worksheet, ByVal header As String) As Range
Set FindHeaderRange = ws.Cells.Find(header, , , xlWhole)
End Function
Sub clearDataSheet2()
Sheets("Destination").Range("A1").CurrentRegion.Offset(1).ClearContents
End Sub
Sub copyColumnData()
On Error GoTo ErrorMessage
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Source")
Set ws2 = ThisWorkbook.Sheets("Destination")
clearDataSheet2
Dim numRowsToCopy As Long
numRowsToCopy = ws1.Cells(RowIndex:=Rows.Count, ColumnIndex:=1).End(xlUp).Row - 1
'MsgBox "The no of rows to copy is " & numRowsToCopy
Dim destRowOffset As Long
destRowOffset = ws2.Cells(RowIndex:=Rows.Count, ColumnIndex:=1).End(xlUp).Row
'MsgBox "The next Blank row is " & destRowOffset
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim dictKey As Variant
Dim header As String
Dim numColumnsToCopy As Long
Dim source As Range
Dim dest As Range
Dim headersDict As Scripting.Dictionary
Set headersDict = GetHeadersDict()
For Each dictKey In headersDict
header = dictKey
If headersDict.Item(header) = False Then
Set source = FindHeaderRange(ws1, header)
If Not (source Is Nothing) Then
Set dest = FindHeaderRange(ws2, header)
If Not (dest Is Nothing) Then
headersDict.Item(header) = True
' Look at successive headers to see if they match
' If so, copy these columns altogether to make the macro faster
For numColumnsToCopy = 1 To headersDict.Count
'MsgBox numColumnsToCopy
If source.Offset(ColumnOffset:=numColumnsToCopy).Value = dest.Offset(ColumnOffset:=numColumnsToCopy).Value Then
headersDict.Item(source.Offset(ColumnOffset:=numColumnsToCopy).Value) = True
Else
Exit For
End If
Next numColumnsToCopy
source.Offset(RowOffset:=1).Resize(RowSize:=numRowsToCopy, ColumnSize:=numColumnsToCopy).Copy _
dest.Offset(RowOffset:=destRowOffset)
End If
End If
End If
Next dictKey
Dim msg As String
For Each dictKey In headersDict
header = dictKey
If headersDict.Item(header) = False Then
msg = msg & vbNewLine & header
End If
Next dictKey
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If msg Not Equal To "" Then
MsgBox "The following headers were not copied:" & vbNewLine & msg
End If
Exit Sub
ErrorMessage:
MsgBox "An error has occurred: " & Err.Description
Resume ExitSub
End Sub
This code works perfectly but i am unable to satisfy two condition:-
Destination excel has Column header in second row. I am unable to compare column header in second row and paste the data from third row
i am unable to read source file as csv and i want to give path by user how can i do that .

Answer 1

Welcome to stack. Assuming you didn't wrote this code yourself you'll need to be willing to learn if you want our help.
That said, all beginning is difficult so assuming you just want to copy columns from a CSV based on a limited list of predefined headers the script you posted is a total overkill imho. So I propose to use this as our base:
Option Explicit
Sub move()
Dim arr, arr2, j As Long, i As Long
arr = Sheet1.Range("A1").CurrentRegion.Value2 'get the source, we'll replace this with the csv import later
ReDim arr2(1 To UBound(arr), 1 To UBound(arr, 2)) 'setup the destination array
For j = 1 To UBound(arr) 'rows, start at the header row
For i = 1 To UBound(arr, 2) 'columns
Select Case arr(1, i)
Case "Name" 'the column names we want to match
arr2(j, 1) = arr(j, i)
'Add the rest of your cols here with Case colname
End Select
Next i
Next j
With Sheet2
.Range(.Cells(1, 1), .Cells(UBound(arr2), UBound(arr2, 2))).Value2 = arr2 'dump to sheet, if you want your destination to start at row 3 change it here
End With
End Sub
It's not yet doing what you want but it should get you on the right path. Complete the code above and post it again if you want more help.