Concatenate With Loop Through 2 Columns of Information

**nigelld** · 05-28-2014, 06:47 AM

Hi Thanks for any help in advance.
I have a list of names with blank cells in Column A cell 2.
I want the programme to scroll through this column until it finds a name, when it does I want it to look in cell offset(1, 1), in this case B3 to see if there is a number. I want this number to be moved to offset (0, 1) AND any subsequent numbers below it until the next blank cell in that column (B).
In the attached image cell B2 will contain all numbers in cells B3:B9 with a / between them. Cell B10 will have number from B11 and B12 will have B13:B15. If there is no number it will just continue to the next name in column A. My rough code below delivered the first number only in the relevant cell and I'm not clever enough to get it right. It does not have to be super slick as it's for one time use. Again thank you ;-)
Sorry forgot to say I need numbers in column B cleared as they are concatenated into the single cell.

Spreadsheet.jpg


Sub Concatene()
Dim rng As Long
Dim r As Integer

  For r = 2 To 9440
 Cells(r, 1).Select
 If Selection <> "" Then If Selection.Offset(1, 1) <> 0 Then Selection.Offset(0, 1) = Selection.Offset(0, 1) & "/" & Selection.Offset(1, 1)
 
 Next
 
End Sub

**JOHN H. DAVIS** · 05-28-2014, 06:58 AM

Maybe:

Sub nigelld()
Dim rcell As Range
For Each rcell In Range("A2:A" & Range("B" & Rows.count).End(3)(1).Row)
    If rcell.Value <> "" Then
        rcell.offset(1, 1).Cut rcell.offset(, 1)
    End If
Next rcell
End Sub

**nigelld** · 05-28-2014, 08:14 AM

Hi John
Thanks for that, but it only moves the first number up then scrolls through the remaining numbers, then after the next blank moves the first number again.
Nigel ;-)

**JOHN H. DAVIS** · 05-28-2014, 08:22 AM

Maybe:

Sub nigelld()
Dim i As Long
For i = Range("B" & Rows.count).End(3)(1).Row To 2 Step -1

    If Range("A" & i).Value <> "" Then
        Range("A" & i).offset(1, 1).Cut Range("A" & i).offset(, 1)
        Rows(i + 1).Delete
    End If
Next i
End Sub

**nigelld** · 05-28-2014, 09:48 AM

Although I'm eternally grateful for all help I can't get that bit of code to concatenate all the numbers, it just takes the first one and deletes it and I need all the numbers below the name, if any, and before the next blank cell adjacent to the next name to be in the adjacent cell to the name. Sorry ;-)

**JOHN H. DAVIS** · 05-28-2014, 09:58 AM

Can you attach a file with some sample data. Preferably with a Sheet before the macro is run, and a Sheet with what you want it too look like after the macro is run. To attach a file, push the button with the paperclip (or scroll down to the Manage Attachments button), browse to the required file, and then push the Upload button.

**nigelld** · 05-28-2014, 09:28 AM

Thanks John cannot believe how quickly you do that ;-)

**nigelld** · 05-28-2014, 10:08 AM

Thanks John I will do it as soon as I get back to my pc

Sent from my HTC One using Tapatalk

**nigelld** · 05-28-2014, 05:32 PM

Hi John
I have attached the file. The blank rows I can get rid afterwards with a simple sort.
Thank you
Nigel

**JOHN H. DAVIS** · 05-29-2014, 07:41 AM

Maybe:

Sub nigelld()
Dim i As Long
Dim x As String
x = ""
For i = 2 To Range("B" & Rows.count).End(3)(1).Row

    If Range("A" & i).Value <> "" And Range("B" & i).Value = "" Then
        Range("B" & i + 1).Select
        If ActiveCell.Value <> "" And ActiveCell.offset(, -1) = "" Then
            Do Until ActiveCell.Value = ""
            x = x & "/" & ActiveCell.Value
            ActiveCell.offset(1).Select
            Loop
            Range("B" & i).Value = x
        Else: GoTo zz
        End If
    End If
zz:
                
x = ""
Next i
For Each rcell In Range("B2:B" & Range("B" & Rows.count).End(3)(1).Row)
    If rcell.offset(, -1).Value = "" Then rcell.Value = ""
    If rcell.Value <> "" Then rcell.Value = Right(rcell, Len(rcell) - 1)
Next rcell
End Sub

**nigelld** · 05-29-2014, 03:02 PM

Thank you very much John it worked perfectly BIG :-)

**JOHN H. DAVIS** · 05-29-2014, 03:13 PM

You're welcome. Glad to help out and thanks for the feedback. Please comply with Forum Rule No 9.

9. Acknowledge the responses you receive, good or bad. If your problem is solved, please say so clearly, and mark your thread as Solved: Click Thread Tools above your first post, select "Mark your thread as Solved". Or click the Edit button on your first post in the thread, Click Go Advanced, select [SOLVED] from the Prefix dropdown, then click Save Changes. If more than two days have elapsed, the Dropdown option or Edit button will not appear -- ask a moderator to mark it.

**nigelld** · 05-29-2014, 03:20 PM

Will do

Sent from my HTC One using Tapatalk

Concatenate With Loop Through 2 Columns of Information

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Re: Concatenate With Loop Through 2 Columns of Information

Thread Information

Users Browsing this Thread

Similar Threads

Nested loop to concatenate 2 columns of data

Concatenate columns with information base on user selection

[SOLVED] Return row 1 information if selected and concatenate

VBA loop through table combine like columns and add and concatenate respective cell

Concatenate the information under same name and delete the duplicate, AGAIN!

Bookmarks

Bookmarks

Posting Permissions