0

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  
3
  • Are the headers in a specific row? Commented Mar 17, 2020 at 3:54
  • The headers are in A1:Y1 Commented Mar 17, 2020 at 10:52
  • 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)) Commented Mar 18, 2020 at 12:00

3 Answers 3

1

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
Sign up to request clarification or add additional context in comments.

Comments

1

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.

5 Comments

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.
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.
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
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
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.
0

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

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.