Transfer Data by matching Header - vba

Question

I have a Backend raw output data set, which consists of multiple columns with some of them being empty except of the header.
I would like to transfer this data into another worksheet, let's call it Backend - processed. In this worksheet, I would prepare a header row, which consists of some of the headers included in the original data set. There won't be any new headers in the processed worksheet (so basically headers(processed) is a subset of headers(raw output)).
Once, I used to solve this problem with a function (Index & Match), but with growing raw data sets, this became suboptimal from a performance perspective.
Since then, I've been reading up on VBA codes and this is what I came up with until now:
Sub test()
Dim r As Range, c As Range, msg As String
With Sheets("Backend - raw").Range("4:4").CurrentRegion
For Each r In Sheets("Backend - processed").Range("b7:t7")
Set c = .Rows(1).Find(r.Value, , , xlWhole, , 0)
If Not c Is Nothing Then
.Columns(c.Column).Copy
r.PasteSpecial xlPasteValues
Else
msg = msg & vbLf & r.Value
End If
Next
Application.CutCopyMode = False
End With
End Sub
The Range 4:4 is where the headers of the original raw data output are found. Range b7:t7 is where the headers of the processed data table are found.
Being a total beginner at VBA, I'm quite happy that it works, but still think that there is a huge margin for improvement:
1) It's still pretty slow, taking about 10 seconds to complete 40x500 arrays.
2) I don't know how to make it stop looking for the next header, if the last header was blank (end of range b7:t7)
3) I'm very much open to new/better approaches to tackle this issue.

Answer 1

Searching, copying and pasting can be quite time consuming affairs. You'd probably be better off reading the headers just once into some kind of stored list (a Collection would work well for you because it could store the column number as its value and the header text as its key.
Given that you are only copying and pasting values (ie you don't need to pass cell formatting into your processed sheet) then reading the values into an array and then writing that array to the sheet will be quicker.
The code below is an example of that, but I'm sure with more thought it could be made even quicker (for example by discarding a header from the collection once it's been used, or not having to find the last row number for every individual column).
Dim rawSht As Worksheet
Dim procSht As Worksheet
Dim headers As Collection
Dim c As Integer
Dim v As Variant
Set rawSht = ThisWorkbook.Worksheets("Backend - raw")
Set procSht = ThisWorkbook.Worksheets("Backend - processed")
Set headers = New Collection
For c = 1 To rawSht.Cells(4, Columns.Count).End(xlToLeft).Column
headers.Add c, rawSht.Cells(4, c).Text
Next
For c = 2 To 20
rawCol = headers(procSht.Cells(7, c).Text)
v = rawSht.Range(rawSht.Cells(5, rawCol), rawSht.Cells(Rows.Count, rawCol).End(xlUp)).Value2
procSht.Cells(8, c).Resize(UBound(v, 1)).Value = v
Next

Answer 2

This is using arrays (40 cols x 1000 rows in 0.03125 sec)
Option Explicit
Sub testArr()
Const HDR1 As Long = 4 'header row on sheet 1
Const HDR2 As Long = 7 'header row on sheet 2
Dim ws1 As Worksheet, ur1 As Range, vr1 As Variant, c1 As Long, c2 As Long, r As Long
Dim ws2 As Worksheet, ur2 As Range, vr2 As Variant, msg As String, t As Double
t = Timer
Set ws1 = Worksheets("Backend - raw")
Set ws2 = Worksheets("Backend - processed")
Set ur1 = ws1.UsedRange
Set ur2 = ws2.UsedRange.Rows(ws2.UsedRange.Row - HDR2 + 1)
Set ur2 = ur2.Resize(ur1.Row + ur1.Rows.Count - HDR1 + 1)
vr1 = ur1 'copy from Range to array
vr2 = ur2
For c1 = 1 To UBound(vr1, 2)
For c2 = 1 To UBound(vr2, 2)
If vr1(1, c1) = vr2(1, c2) Then
For r = 2 To UBound(vr1, 1)
vr2(r, c2) = vr1(r, c1)
Next
Exit For
Else
msg = msg & vbLf & vr1(HDR1, c1)
End If
Next
Next
ur2 = vr2 'copy from array back to Range
Debug.Print "testArr duration: " & Timer - t & " sec"
End Sub