Concatenete two cells if I have a blank cell in the next Column

this is my first post to this group. I have a simple spreadsheet, with 30k rows. So, under column B, I have a blank cell, this will indicate under column A the address is over two rows, I want to concatenate these 2 cells into one cell. I have VBA code that I have put together but I am at the beginners level and not too sure how to proceed to the next step. Can I get some help please?

Sub Merge()

Dim LR As Integer
Dim icell As Range
Dim strMerge As String
Dim MyCell As Range

'Add new Sheet and rename it
Worksheets.Add After:=Worksheets("Austin Grids")
ActiveSheet.Name = "Austin Grids1"

'Copy sheets contents from original to the new sheet
Sheets("Austin Grids").Cells.Copy Destination:=Sheets("Austin Grids1").Range("A1")

'Find last row of current sheet
LR = Worksheets("Austin Grids1").Cells(Rows.Count, 1).End(xlUp).Row

Set MyCell = Sheets("Austin Grids1").Range("A:A")

'Move rows of where column is null
For Each icell In Range("B:B")
        If icell.Value = "" Then
        icell.Offset(0, -1).Select
        strMerge = MyCell.Value
        End If
Next icell

End Sub

Forgive me if this does not come out right, my first post. Thanks!


2 answers

  • answered 2018-10-16 14:16 BruceWayne

    You don't need to use VBA, so if I may, I will offer a formula solution.

    In H2, paste this formula and drag as far down as needed:

    =IF(B1="",A1&" "&A2,"")

    Note: You may just need A1&A2, I can't tell if column A actually has leading spaces in those names, or that's formatting

    Then, in I2, paste this and drag right:


    enter image description here

  • answered 2018-10-16 15:05 BruceWayne

    Here's the loop you can use for VBA. It will start at the end, moving up row-by-row until it reaches Row 2.

    Dim totalRows As Long, i As Long
    totalRows = Range("A1").End(xlDown).Row
    With Sheets("Austin Grids1")
    For i = totalRows To 2 Step -1
        If .Cells(i, 2) = "" Then
            .Cells(i + 1, 1).Value = .Cells(i, 1).Value & .Cells(i + 1, 1).Value
            .Cells(i, 1).EntireRow.Delete
        End If
    Next i
    End With