Using vba to find column headers and adding a new record under that header

Question

I am trying to create something that is capable of taking the value from one text box, searching a group of column headers to find the correct one, and then placing a new value from a second text box into the last row under that column. I adapted this code that I found on here, https://stackoverflow.com/a/37687346/13073514, but I need some help. This code posts the value from the second text box under every header, and I would like it to only post it under the header that is found in textbox 1. Can anyone help me and explain how I can make this work? I am new to vba, so any explanations would be greatly appreciated.

Public Sub FindAndConvert()
Dim i           As Integer
Dim lastRow     As Long
Dim myRng       As Range
Dim mycell      As Range
Dim MyColl      As Collection
Dim myIterator  As Variant

Set MyColl = New Collection

MyColl.Add "Craig"
MyColl.Add "Ed"

lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For i = 1 To 25
    For Each myIterator In MyColl
        If Cells(1, i) = myIterator Then
            Set myRng = Range(Cells(2, i), Cells(lastRow, i))
            For Each mycell In myRng
                mycell.Value = Val(mycell.Value)
            Next
        End If
    Next
Next
End Sub  

Answer 1

Edit/Preamble

Sorry, didn't read that you want to use TextBoxes and to collect data one by one instead of applying a procedure to a whole data range.

Nevertheless I don't remove the following code, as some readers might find my approach helpful or want to study a rather unknown use of the Application.Match() function :)

Find all header columns via single Match()

This (late) approach assumes a two-column data range (header-id and connected value).

It demonstrates a method how to find all existant header columns by executing a single Application.Match() in a ►one liner ~> see step [3].

Additional feature: If there are ids that can't be found in existant headers the ItemCols array receives an Error items; step [4] checks possible error items adding these values to the last column.

The other steps use help functions as listed below.

• [1] getDataRange() gets range data assigning them to variant data array
• [2] HeaderSheet() get headers as 1-based "flat" array and sets target sheet
• [3] see explanation above
• [4] nxtRow() gets next free row in target sheet before writing to found column

Example call

Sub AddDataToHeaderColumn()
    '[1] get range data assigning them to variant data array
    Dim rng As Range, data
    Set rng = getDataRange(Sheet1, data)       ' << change to data sheet's Code(Name)

    '[2] get headers as 1-based "flat" array
     Dim targetSheet As Worksheet, headers
     Set targetSheet = HeaderSheet(Sheet2, headers)

    '[3] match header column numbers (writing results to array ItemCols as one liner)
    Dim ids:      ids = Application.Transpose(Application.Index(data, 0, 1))
    Dim ItemCols: ItemCols = Application.Match(ids, Array(headers), 0)

    '[4] write data to found column number col
    Dim i As Long, col As Long
    For i = 1 To UBound(ItemCols)
        'a) get column number (or get last header column if not found)
         col = IIf(IsError(ItemCols(i)), UBound(headers), ItemCols(i))
        'b) write to target cells in found columns
        targetSheet.Cells(nxtRow(targetSheet, col), col) = data(i, 2)
    Next i
End Sub

Help functions

I transferred parts of the main procedure to some function calls for better readibility and as possible help to users by demonstrating some implicit ByRef arguments such as [ByRef]mySheet or passing an empty array such as data or headers.

'[1]
Function getDataRange(mySheet As Worksheet, data) As Range
'Purpose: assign current column A:B values to referenced data array
'Note:    edit/corrected assumed data range in columns A:B
With mySheet
    Set getDataRange = .Range("A2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    data = getDataRange          ' assign range data to referenced data array
End With
End Function

'[2]
Function HeaderSheet(mySheet As Worksheet, headers) As Worksheet
'Purpose: assign titles to referenced headers array and return worksheet reference
'Note:    assumes titles in row 1
With mySheet
    Dim lastCol As Long: lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    headers = Application.Transpose(Application.Transpose(.Range("A1").Resize(1, lastCol)))
End With
Set HeaderSheet = mySheet
End Function

'[4]
Function nxtRow(mySheet As Worksheet, ByVal currCol As Long) As Long
'Purpose: get next empty row in currently found header column
With mySheet
     nxtRow = .Cells(.Rows.Count, currCol).End(xlUp).Row + 1
End With
End Function

Answer 2

Basic example:

Sub tester()

    AddUnderHeader txtHeader.Text, txtContent.Text

End Sub

'Find header 'theHeader' in row1 and add value 'theValue' below it,
'  in the first empty cell 
Sub AddUnderHeader(theHeader, theValue)
    Dim m
    With ThisWorkbook.Sheets("Data")
        m = Application.Match(theHeader, .Rows(1), 0)
        If Not IsError(m) Then
            'got a match: m = column number
            .Cells(.Rows.Count, m).End(xlUp).Offset(1, 0).Value = theValue
        Else
            'no match - warn user
            MsgBox "Header '" & theHeader & "' not found!", vbExclamation
        End If
    End With
End Sub

Answer 3

I have commented your code for your better understanding. Here it is.

Public Sub FindAndConvert()

    Dim i           As Integer
    Dim lastRow     As Long
    Dim myRng       As Range
    Dim myCell      As Range
    Dim MyColl      As Collection
    Dim myIterator  As Variant

    Set MyColl = New Collection

    MyColl.Add "Craig"
    MyColl.Add "Ed"
    Debug.Print MyColl(1), MyColl(2)        ' see output in the Immediate Window

    ' your code starts in the top left corner of the sheet,
    ' moves backward (xlPrevious) from there by rows (xlByRows) until
    ' it finds the first non-empty cell and returns its row number.
    ' This cell is likely to be in column A.
    lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = 1 To 25                         ' do the following 25 times
        ' in Cells(1, i), i represents a column number.
        ' 1 is the row. It never changes.
        ' Therefore the code will look at A1, B1, C1 .. until Y1 = cells(1, 25)
        For Each myIterator In MyColl       ' take each item in MyColl in turn
            If Cells(1, i) = myIterator Then
                ' set a range in the column defined by the current value of i
                ' extend it from row 2 to the lastRow
                Set myRng = Range(Cells(2, i), Cells(lastRow, i))
                ' loop through all the cells in myRng
                For Each myCell In myRng
                    ' convert the value found in each cell to a number.
                    ' in this process any non-numeric cells would become zero.
                    myCell.Value = Val(myCell.Value)
                Next myCell
            End If
        Next myIterator
    Next i
End Sub

As you see, there is no TextBox involved anywhere. Therefore your question can't be readily understood. However, my explanations may enable you to modify it nevertheless. It's all a question of identifying cells in the worksheet by their coordinates and assigning the correct value to them.