Forum Discussion

JayNixon's avatar
JayNixon
Copper Contributor
Jul 15, 2019

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...
  • Brad_Yundt's avatar
    Brad_Yundt
    Jul 16, 2019

    JayNixon

    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

Resources