Write multiple values to one cell - VBA

Question

I am very new to VBA and am trying to determine how to store multiple values within one cell. For example, I first:

Scanned through each cell within a row to determine if it was blank. (A2:F3)
I then identified the column header for that blank cell. (A1:F1)
I created a message box that says the cell and the title of the corresponding column header. (The cell is empty. The column header is state.)

I need some help figuring out:

How to loop so that each column header does not overwrite the next one when it saves to column G.
How to loop and concatenate so that multiple column headers within one row will be in the same cell. (For example, Name, School, State - those would be the headers I am pulling into the last column.)

Thank you for any help you can offer!

Sub EmptyCells()

Dim Cell As Range
Dim lrow As Long, i As Integer
Dim lcol As Long
Dim rw As Range
Dim reString As String
Dim ResultRng As Range


    'Find the last non-blank cell in Column "School"
    lrow = Cells(Rows.Count, 3).End(xlUp).Row
    lcol = Cells(1, Columns.Count).End(xlToLeft).Column

    MsgBox "Last Row: " & lrow


   Set ResultRng = Range("G2:G3")

For Each rw In Sheets(1).Range("A1:F3").Rows
    For Each Cell In rw.Cells
        If IsEmpty(Cell.Value) Then
            'MsgBox Cell.Address & " is empty. " & "The cell row number is " & Cell.Row & "." & vbNewLine & "The column header is " & Cell.Offset((1 - Cell.Row), 0)

            ResultRng = Cell.Offset((1 - Cell.Row), 0)

        End If
    Next

Next

MsgBox "Complete"

End Sub

You might find the UDFs in [Concatenate column headers if value in rows below is non-blank](https://stackoverflow.com/questions/43104790/concatenate-column-headers-if-value-in-rows-below-is-non-blank/43105199#43105199), [Concatenate top row cells if column below has 1](https://stackoverflow.com/questions/28679758/concatenate-top-row-cells-if-column-below-has-1/28680713#28680713) and [TEXTJOIN for xl2013 with criteria](https://stackoverflow.com/questions/50716550/textjoin-for-xl2013-with-criteria/50719050?s=1|93.5510#50719050) interesting. — , Jun 10 '18 at 08:01

score 2 · Accepted Answer · 2018-06-10T07:47:35.707

I've used your lrow and lcol a little more extensively here.

Sub EmptyCells()
    Dim lrow As Long, lcol As Long
    Dim i As Integer, r As Long, c As Long
    Dim reString As String

    With Worksheets("sheet1")
        'Find the last non-blank cell in Column "School"
        lrow = .Cells(.Rows.Count, 3).End(xlUp).Row
        lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        MsgBox "Last Row: " & lrow

        For r = 2 To lrow
            reString = vbnullstring
            For c = 1 To lcol
                If IsEmpty(.Cells(r, c)) Then
                    'MsgBox .Cells(r, c).Address(0,0) & " is empty. " & _
                            "The cell row number is " & r & "." & vblf & _
                            "The column header is " & .Cells(1, c).value
                    reString = reString & ", " & .Cells(1, c).Value
                End If
            Next c
            .Cells(r, c) = Mid(reString, 3)
        Next r
    End With

    MsgBox "Complete"

End Sub

Yes!!! Thank you so much and for such a quick response!! This works perfectly. I want to make sure I understand. Can you explain what the reString line is doing? (reString = reString & ", " & .Cells(1, c).Value) and then the Mid(reString,3)?? Thank you!!! — ms_queen, Jun 10 '18 at 18:35
The former concatenates matching headers together with a comma/space delimiter; the latter strips off the redundant first delimiter. — , Jun 10 '18 at 20:30

Write multiple values to one cell - VBA

1 Answers1