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

Side note: it's always dangerous to rely on explicit or implict `ActiveSheet` references to avoid a wrong ref or error. It's preferrable in most cases to fully qualify your **range** (including `.Cell`) **references**, e.g. via `ThisWorkbook.Worksheets("Sheet1").Range(...)` or via the sheet's Code(Name) related to a project, e.g. `Sheet1.Range(...)` or by declaring/setting a worksheet object to memory e.g. via `Dim ws As Worksheet` and `Set ws = ThisWorkBook.Worksheets("Sheet1")` and referring to it via `ws.Range(...)`. Ex.: `Set myRng = Range(ws.Cells(2, i), ws.Cells(lastRow, i))` — T.M., Mar 18 '20 at 12:00

score 1 · Answer 1 · answered Mar 17 '20 at 05:39

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.

Thank you for this. It has helped me understand a lot more. I made the first textbox equal to myIterator, and I now have it posting data from the second textbox. Do you know what I can change to make it only post to one specific column and not all 25? When I try to edit the I it makes it post just to column 1. — K0D54, Mar 17 '20 at 13:45
One after the other, `Cells(1, i).Value` is the column caption which is checked against each name in the collection. Action is only taken ` If Cells(1, i).Value = myIterator`. You can terminate action after that has happened. Add `Exit For` after `Next MyCell` and before `End If`. However, that would still leave you in the `myIterator` loop. If you want to exit that as well, declare `Dim Done As Boolean` (at the top) and add `Done = True` before `Exit For`. Then before `Next Iterator` add `If Done Then Exit For` and do the same before `Next i`. — Variatus, Mar 17 '20 at 14:04
sorry to keep bugging you but you're very helpful. I think the last issue that I am having is searching the textbox. I don't think I am actually pulling from the textbox which is causing the information pulled from textbox 2 to always appear in the first column. Can you tell me what I am doing wrong? Or at least point me in the right direction — K0D54, Mar 17 '20 at 21:30
lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 For i = 1 To 21 For Each myIterator In MyColl If Me.txt_Names = myIterator Then Set myRng = Range(Cells(lastRow, i), Cells(lastRow, i)) For Each mycell In myRng mycell.Value = Me.txt_Food Next Done = True Exit For End If If Done Then Exit For Next If Done Then Exit For Next — K0D54, Mar 17 '20 at 21:30
I don't see any text box in your code, let alone two. I can't imagine how to "search a textbox" and might misunderstand what you mean by"pulling from a textbox". I respectfully suggest that you create a new question in which you clarify the "textbox" term because we simply don't have the space here to deal with the issue successfully. — Variatus, Mar 18 '20 at 00:49

score 1 · Accepted Answer · answered Mar 17 '20 at 22:14

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

T.M. · Answer 3 · 2020-03-19T17:22:08.633

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

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

3 Answers3