Loop through column

RedMan7

New Member
Joined
Feb 15, 2019
Messages
20
Hello All,

I am trying to loop through values in a column and input them into a list (on a separate cell in the sheet). However, if while looping, a blank cell is encountered, I do not want that value to be added to the list. Is there a way to do this without VBA and if not, would you be able to help me write a script that allows me to do this? Thank you very much.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
A macro can be recorded from :
• Copy the whole column and paste to a new column
• Select the new column and go to SpecialCells/Blanks
• Delete/ShiftCellsUp
 
Upvote 0
Footoo,

Thanks for your reply, but I don't want to delete any rows. I simply have a column that has comments in each row, and I want to pick up comments that are in each one of those cells in that column and add them to a text box - this is why I want to add the contents of that list into a cell which I can then link to a text box.
 
Upvote 0
With your list in column A and with B1 as the destination cell :
Code:
Sub Concat()
Dim c As Range, s$
For Each c In Range("[COLOR=#ff0000]A1:A[/COLOR]" & Cells(Rows.Count, "[COLOR=#ff0000]A[/COLOR]").End(xlUp).Row)
    If Not IsEmpty(c) Then s = s & Chr(10) & c
Next
[[COLOR=#ff0000]B1[/COLOR]] = Right(s, Len(s) - 1)
End Sub
 
Upvote 0
Hi footoo,

I tried putting the code in, but it doesn't work - would you be able to guide me on what I may not be doing correctly?
 
Upvote 0
In what way does it not work?
Is your list in column A?
Give an example of your data and the result you want.
Perhaps you want to write directly to a text box rather than to a cell?
Do you want the cell/TextBox to update automatically when changes are made to the list?
Does the list contain formulas or constants?
 
Upvote 0
Footoo,

Thanks for your reply. Yes, I've input the code, but it doesn't seem to work properly.

In response to your questions:
In what way does it not work? I've tried to input the code to the same sheet, but nothing happened as I entered values into column A
Is your list in column A? Yes
Give an example of your data and the result you want. It's literally the same thing that you described with me.
Perhaps you want to write directly to a text box rather than to a cell? I do, but would the code not get much more complicated then? I might want to retain the information to a cell as well.
Do you want the cell/TextBox to update automatically when changes are made to the list? If possible, yes. Essentially, I want to attach this info from a cell to a text box and then add this text box to graphs to give more granular data that may not appear from the graph
Does the list contain formulas or constants? No, just text.

I will try to respond later with an attachment - maybe you could add the code to it and send it back if possible?

Thank you very much.

 
Upvote 0
The previously posted macro goes in a normal module, not in the sheet module, and does not run automatically when changes are made to column A.

You didn't mention whether the column A combined cells should be one line per cell.
The posted code does it like that.

If you want put directly to a text box and update automatically when value(s) in column A change(s), put this in the sheet module :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, r2 As Range, c As Range, s$
Set r = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set r2 = Intersect(Target, r)
If Not r2 Is Nothing Then
    For Each c In r
        If Not IsEmpty(c) Then s = s & Chr(10) & c
    Next
End If
With ActiveSheet.Shapes("Textbox 1").TextFrame.Characters
    If s = "" Then
        .Text = ""
    Else
        .Text = Right(s, Len(s) - 1)
    End If
End With
End Sub


If you want put in a cell instead of a text box, and run automatically, put this in the sheet module :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, r2 As Range, c As Range, s$
Set r = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set r2 = Intersect(Target, r)
If Not r2 Is Nothing Then
    For Each c In r
        If Not IsEmpty(c) Then s = s & Chr(10) & c
    Next
End If
Application.EnableEvents = False
[B1] = IIf(s = "", "", Right(s, Len(s) - 1))
Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0
Amended "put to cell" macro :
Code:
Private Sub xWorksheet_Change(ByVal Target As Range)
Dim r As Range, r2 As Range, c As Range, s$
Set r = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set r2 = Intersect(Target, r)
If Not r2 Is Nothing Then
    For Each c In r
        If Not IsEmpty(c) Then s = s & Chr(10) & c
    Next
End If
Application.EnableEvents = False
If s = "" Then
    [B1] = ""
Else
    [B1] = Right(s, Len(s) - 1)
End If
Application.EnableEvents = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,194
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top