Search column headers and insert new column if header does not already exist using Excel VBA - excel

Question

I have a spreadsheet that is updated regularly. The user will update two columns on sheet(create) with container type (this is the header name) and the quantity, which will be transferred to sheet(Tracking). I am trying to figure out how to search sheet2(Tracking for existing headers (container types), if found then quantity will be updated within that column for the next available row. If header is not found, therefore a new column is added to the right with that new header name, as well as updating the quantity.
I did find some good example such as the below. However not sure how to apply it. Maybe there could be a way to loop it to search the headers.
Sub TrackR()
Dim cl As Range
For Each cl In Range("1:1")
If cl = sheets(“Create”).range(“J11:J36”) Then
cl.EntireColumn.Insert Shift:=xlToRight
End If
cl.Offset(0, 1) = "New Conatainer Name"
Next cl
Application.ScreenUpdating = False
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Date
'Trailer No.
Sheets("Create").Range("L8").Copy
Sheets("Tracking").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'total container qty
Sheets("Create").Range("G43").Copy
Sheets("Tracking").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Supplier
Sheets("Create").Range("K4").Copy
Sheets("Tracking").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'quantities
Sheets("Create").Range("L11").Copy
Sheets("Tracking").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Create").Range("L12").Copy
Sheets("Tracking").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Create").Range("L13").Copy
Sheets("Tracking").Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Create").Range("L14").Copy
Sheets("Tracking").Range("H" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Create").Range("L15").Copy
Sheets("Tracking").Range("I" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub

Answer 1

Not sure, try this ... ~
Sub TrackB()
Dim wsCreat As Worksheet: Set wsCreat = Sheets("Create")
Dim wsTracking As Worksheet: Set wsTracking = Sheets("Tracking")
Dim cl As Range, lastHCell As Range, header As Range, i As Integer, j As Integer,k as integer, str As Variant
With wsTracking
Set header = .[a1:xx1]: Set lastHCell = header.End(xlToRight)
iLstRow = .[a10000].End(xlUp).Offset(1, 0).Row
'Update default data [A:D]
.Range("A" & iLstRow) = Date
For Each str In Array("L8", "C4", "G43")
.Cells(iLstRow, i + 2) = wsCreat.Range(str): i = i + 1
Next
'add Column if not Match
For Each cl In wsCreat.[B11:B37, E11:E37]
Dim k: k = Application.Match(cl, header, 0)
If IsError(k) And cl <> vbNullString Then _
lastHCell.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=True: _
Set lastHCell = lastHCell.Offset(0, 1): lastHCell.Value2 = cl
Next cl
'Update input Data
i = 5
Dim arr As Variant: arr = Array("B11:B37", "E11:E37")
Dim arrResult As Variant: arrResult = Array("C10" , "F10")
Dim cell As Range: k = 0
For k = 0 To UBound(arr)
j=1
For Each cell In wsCreat.Range(arr(k)).Cells
If cell.Value2 <> vbNullString Then
.Cells(iLstRow, Application.Match(cell, header, 0)) = wsCreat.Range(arrResult(k)).Offset(j, 0)
End If
j = j + 1
Next cell
Next
End With
End Sub

Answer 2

Untested but something like this should work:
Sub TrackR()
Dim wsTrack As Worksheet, wsCreate As Worksheet, cont, qty, h As Range
Dim c As Range, m, rw As Range, rngHeaders As Range, col As Long
Set wsCreate = ThisWorkbook.Worksheets("Create")
Set wsTrack = ThisWorkbook.Worksheets("Track")
'get the next empty row on the Tracking sheet
Set rw = wsTrack.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
'fill in the common cells in the row
rw.Cells(1).Value = Date
rw.Cells(2).Value = wsCreate.Range("L8").Value
rw.Cells(3).Value = wsCreate.Range("K4").Value
rw.Cells(4).Value = wsCreate.Range("G43").Value
'now loop over the containers and add each one
Set rngHeaders = wsTrack.Cells(1, "E").Resize(1, 5000) 'or whatever would cover your data
For Each c In wsCreate.Range("J11:J36").Cells
cont = c.Value
qty = c.Offset(0, 2).Value
If Len(cont) > 0 And Len(qty) > 0 Then
m = Application.Match(cont, rngHeaders, 0) 'any existing match ?
If IsError(m) Then
'no match - find the first empty cell and add the container
Set h = rngHeaders.Cells(rngHeaders.Cells.Count).End(xlToLeft).Offset(0, 1)
h.Value = cont
col = h.Column 'column number for the added header
Else
'matched: get the column number
col = rngHeaders.Cells(m).Column
End If
rw.Cells(col).Value = qty '<< add the quantity
End If
Next c
End Sub