Concatenating column B values if left adjacent cell is empty

I need to combine cells in column B if the value in the cell to the left is blank while also deleting the blank cell to the left to close any gaps between cells in Column A. The best way for me to ex...

ExampleExcel.xlsx9 KB

excel

Formulas and Functions

Jul 16, 2019

I revised the macro to allow up to 200 more rows of results in case of overflow, as well as up to 165 characters in next pass through the concatenation loop. When an overflow situation is detected, the server name will be repeated as often as needed to get all software names listed on additional rows.

Sub Sequelize()
Dim rg As Range
Dim delimiter As String, s As String
Dim i As Long, k As Long, n As Long, nData As Long
Dim vData As Variant, vResults As Variant

delimiter = ", "
Set rg = Range("A2").CurrentRegion
Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
n = rg.Rows.Count
nData = Application.CountA(rg.Columns(1))
nData = nData + 200 'Allow for servers whose software list exceeds 32,767 characters
vData = rg.Value
ReDim vResults(1 To nData, 1 To 2)

For i = 1 To n
    If vData(i, 1) <> "" Then
        k = k + 1
        vResults(k, 1) = vData(i, 1)
        If s <> "" Then
            If i > 1 Then vResults(k - 1, 2) = Left$(s, 32767)
        End If
        s = IIf(vData(i, 2) = "", "", vData(i, 2))
    Else
        If vData(i, 2) <> "" Then
            If s = "" Then
                s = vData(i, 2)
            Else
                s = s & delimiter & vData(i, 2)
            End If
        End If
    End If
    
    'Overflow occurs if you put more than  32,767 characters in a cell. This block allows up to 165 characters (plus delimiter) in next pass through loop.
    If Len(s) > 32600 Then
        If (i < n) And (vData(i + 1, 1) = "") Then
            vResults(k, 2) = s
            vResults(k + 1, 1) = vResults(k, 1)
            s = ""
            k = k + 1
        End If
    End If
Next
If s <> "" Then vResults(k, 2) = Left$(s, 32767)

rg.ClearContents
rg.Resize(nData, 2).Value = vResults
End Sub

Sub GroupData()
Dim lngRow As Long
Dim lngRowMax As Long
Dim lngz As Long
Dim lngzMax As Long

With Sheet1
.Range("G:H").ClearContents
.Range("G1:H1").Value = .Range("A1:B1").Value
lngz = 2
lngRowMax = .Range("B" & .Rows.Count).End(xlUp).Row

For lngRow = 2 To lngRowMax
If .Range("A" & lngRow).Value <> "" Then
.Range("G" & lngz).Value = .Range("A" & lngRow).Value
.Range("H" & lngz).Value = .Range("B" & lngRow).Value
lngz = lngz + 1
Else
lngzMax = .Range("H" & .Rows.Count).End(xlUp).Row
.Range("H" & lngzMax).Value = .Range("H" & lngzMax).Value & "," & .Range("B" & lngRow).Value
End If

Next lngRow

End With

End Sub

Best regards
Bernd
https://vba-tanker.com/

Forum Discussion

Concatenating column B values if left adjacent cell is empty

Resources