mapping column headers from one sheet to another - excel

Question

i wanted to map columns from one worksheet to another and this is the code i have tried:
Dim x As Integer
x = 2
Do Until Sheets("Sheet1").Range("A" & x).Value = ""
Sheets("Sheet2").Range("C" & x).Value = Sheets("Sheet1").Range("A" & x).Value
x = x + 1
Loop
x = 2
Do Until Sheets("Sheet1").Range("B" & x).Value = ""
Sheets("Sheet2").Range("A" & x).Value = Sheets("Sheet1").Range("B" & x).Value
x = x + 1
Loop
x = 2
Do Until Sheets("Sheet1").Range("C" & x).Value = ""
Sheets("Sheet2").Range("B" & x).Value = Sheets("Sheet1").Range("C" & x).Value
x = x + 1
Loop
in worksheet1 i have:
A B C
1 applicationname applicationid number
2 applcation1 1 123
3 applcation2 2 454
4 applcation3 3 897
in worksheet2 i got:
A B C
1 appid num appname
2 1 123 applcation1
3 2 454 applcation2
4 3 897 applcation3
the problem is there are many other columns and this code seems to be lengthy..i need to loop so that applicationid maps to appid and so on ..i want to know wether there is a way to map columns based on the headers(the data in first row) and can anyone please say what to do if i want to copy the empty cells also?
may i know wether i can have an worksheet like interface say sheet3 where i can fill the required mappings like
A B
1 Application Name App Name
2 Application ID AppID
3 Technology Tech
4 Business Criticality Bus Criticality
5 IT Owner IT Owner
6 Business Owner BusOwner and accordingly map them?thanks in advance

Answer 1

Try this:
Sub Map()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim HeadersOne() As String
Dim HeadersTwo() As String
With ThisWorkbook
Set Sh1 = .Sheets("Sheet1") 'Modify as necessary.
Set Sh2 = .Sheets("Sheet2") 'Modify as necessary.
End With
HeadersOne() = Split("applicationname,applicationid,number", ",")
HeadersTwo() = Split("appname,appid,num", ",")
For HeaderIter = 1 To 3
SCol = GetColMatched(Sh1, HeadersOne(HeaderIter - 1))
TCol = GetColMatched(Sh2, HeadersTwo(HeaderIter - 1))
LRow = GetLastRowMatched(Sh1, HeadersOne(HeaderIter - 1))
For Iter = 2 To LRow
Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
Next Iter
Next HeaderIter
End Sub
Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function
Function GetColMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetColMatched = ColIndex
End Function
Let us know if this helps.
Follow-up Edit:
Here's a way to set up an interface.
Assuming that your set-up is similar to mine...
Sheet1:
Sheet2 (I jumbled the headers on purpose):
Interface Sheet:
Result after running code:
Here's the code. Modify accordingly and make sure your headers are exact.
Sub ModdedMap()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim HeadersOne As Range, HeadersTwo As Range
Dim hCell As Range
With ThisWorkbook
Set Sh1 = .Sheets("Sheet1") 'Modify as necessary.
Set Sh2 = .Sheets("Sheet2") 'Modify as necessary.
Set Sh3 = .Sheets("Interface") 'Modify as necessary.
End With
Set HeadersOne = Sh3.Range("A1:A" & Sh3.Range("A" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
For Each hCell In HeadersOne
SCol = GetColMatched(Sh1, hCell.Value)
TCol = GetColMatched(Sh2, hCell.Offset(0, 1).Value)
LRow = GetLastRowMatched(Sh1, hCell.Value)
For Iter = 2 To LRow
Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
Next Iter
Next hCell
Application.ScreenUpdating = True
End Sub
Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function
Function GetColMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetColMatched = ColIndex
End Function

Answer 2

There's no need in this situation to copy the cells one at a time. Not for any performance reason (unless you have tons and tons of data you probably wouldn't run into any performance issues) - it's just that the code would be simpler if you copied the columns directly from Sheet1 to Sheet2 in one operation per column.
The first step is to identify how many rows total are in Sheet1 that you want to copy. There are many schools of thought on how to obtain a used row count in Excel, but the simplest is probably to use the expression UsedRange.Rows.Count on the worksheet (we subtract 1 because we're not copying the header row):
Dim row_count As Long
row_count = Sheets("Sheet1").UsedRange.Rows.Count - 1
Range("Sheet1!A2").Resize(row_count).Copy Range("Sheet2!C2")
Range("Sheet1!B2").Resize(row_count).Copy Range("Sheet2!A2")
Range("Sheet1!C2").Resize(row_count).Copy Range("Sheet2!B2")
I would be satisfied doing it this way, with one line per column that you want to copy. There's still duplicated code, but it's manageable in my opinion.