Header based column selection and sorting column location - excel

Question

I would like to copy column data based on header and paste it into another sheet on specific location. I have written a code which works perfectly when in the source sheet I have those columns header that I searched for.
Sub Copy()
Dim myCollection(1 To 5) As String
Dim myIterator As Variant
Dim myRng As Range
Dim xlcell As Variant
Dim otherwb As Worksheet
Dim mywb As Workbook
Dim colCounter, i As Integer
Application.ScreenUpdating = False
Set mywb = ThisWorkbook
'Create a collection of header names to search through
myCollection(1) = "Name"
myCollection(2) = "Age"
myCollection(3) = "Region"
myCollection(4) = "Uni"
myCollection(5) = "Grade"
'Where to search, this is the header
Set myRng = mywb.Sheets("Sheet0").Range("A1:E1")
mywb.Worksheets.Add(after:=Worksheets(1)).Name = "Sorted"
Set otherwb = mywb.Sheets("Sorted")
colCounter = 0
'For Each myCollection(i) In myCollection look in each item in the collection
For i = LBound(myCollection) To UBound(myCollection)
' look through each cell in your header
For Each xlcell In myRng.Cells
' when the header matches what you are looking for
If myCollection(i) = xlcell.Value Then
' creating a column index for the new workbook
colCounter = colCounter + 1
mywb.Sheets("Sheet0").Columns(xlcell.Column).Copy
otherwb.Columns(colCounter).Select
otherwb.Paste
End If
Next
Next
otherwb.Range("A1:E1").AutoFilter
End Sub
The problem I am facing now is that for example if it doesn't find header "Uni" in the source sheet then it put column "Grade" on to the 4th column instead of 5th column due to the column counter that I have set. Therefore, I have wrong sequence of column.
However, I would like to create the sorted sheet with defined column header. Therefore, if "Uni" is not available in the source sheet then it should paste "Uni" as a header in the sorted sheet and keep column empty then paste column "Grade".
Regards,
Oliver

Answer 1

Something like this:
So basically you will use Rang.Find to find the name of the Column, if it is found then you can paste it on to the other sheet if it doesn't then it just aste the column header. So your sequence is not Disturbed.
Sub Copy()
Dim myCollection(1 To 5) As String
Dim myIterator As Variant
Dim myRng As Range
Dim xlcell As Variant
Dim otherwb As Worksheet
Dim mywb As Workbook
Dim colCounter, i As Integer
Application.ScreenUpdating = False
Set mywb = ThisWorkbook
'Create a collection of header names to search through
myCollection(1) = "Name"
myCollection(2) = "Age"
myCollection(3) = "Region"
myCollection(4) = "Uni"
myCollection(5) = "Grade"
'Where to search, this is the header
Set myRng = mywb.Sheets("Sheet0").Range("A1:E1")
mywb.Worksheets.Add(after:=Worksheets(1)).Name = "Sorted"
Set otherwb = mywb.Sheets("Sorted")
colCounter = 0
'For Each myCollection(i) In myCollection look in each item in the collection
Dim fnd As Range
For i = LBound(myCollection) To UBound(myCollection)
Set fnd = myRng.Find(myCollection(i))
If Not fnd Is Nothing Then
' creating a column index for the new workbook
colCounter = colCounter + 1
mywb.Sheets("Sheet0").Columns(fnd.Column).Copy
otherwb.Columns(colCounter).Select
otherwb.Paste
Else
colCounter = colCounter + 1
otherwb.Cells(1, colCounter) = myCollection(i)
End If
Next
otherwb.Range("A1:E1").AutoFilter
End Sub

Answer 2

Try this modification:
For Each xlcell In myRng.Cells
colCounter = colCounter + 1 ' increase counter even if header not found
otherwb.Cells(1, colCounter) = myCollection(i) ' write hader even if not found
If myCollection(i) = xlcell.Value Then
' creating a column index for the new workbook
mywb.Sheets("Sheet0").Columns(xlcell.Column).Copy
otherwb.Columns(colCounter).Select
otherwb.Paste
End If
Next
Next
It is not the most elegant solution but it will mend your code.