Forum Discussion
Concatenating column B values if left adjacent cell is empty
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
If you prefer a macro to concatenate, then consider:
Sub Sequelize()
Dim rg As Range, targ As Range
Dim delimiter As String, s As String
Dim i As Long, j As Long, n As Long
delimiter = ", "
Set rg = Range("A2").CurrentRegion
Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
n = rg.Rows.Count
j = 1
For i = n To 1 Step -1
If rg.Cells(i, 1).Value <> "" Then
rg.Rows(i + 1).Resize(j - 1).EntireRow.Delete
If rg.Cells(i, 2).Value <> "" Then s = rg.Cells(i, 2).Value & delimiter & s
If s <> "" Then rg.Cells(i, 2).Value = Left(s, Len(s) - Len(delimiter))
j = 1
s = ""
Else
j = j + 1
If rg.Cells(i, 2).Value <> "" Then s = rg.Cells(i, 2).Value & delimiter & s
End If
Next
End Sub
Thank you Brad_Yundt. I am trying to test this now on my actual worksheet and the only problem I am having is that the sheet is 260,000 rows and my computer will freeze every time I try anything.
Please post a small sample workbook showing your actual data layout.
I propose to use array transfer for speed, and want to get the code right the first time. I therefore need to know the layout, extent of data and complicating factors (merged cells, worksheet protection, adjacent columns that must not be deleted, blank rows, etc).
Brad
Going somewhat out on a limb here without a sample workbook to look at. I revised the code to use array transfer into VBA and back. It will run a lot faster as a result.
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)) 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) = s 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 Next If s <> "" Then vResults(k, 2) = s rg.ClearContents rg.Resize(nData, 2).Value = vResults End SubI apoligize for the delay in response here Brad_Yundt. I was having trouble with my laptop because excel was crashing often. I will attach a very small sample of the data I am working with. I am basically looking at all the software/applications installed on all the servers in my domain. I want all the applications belonging to each server to be in one cell block and be separated by a comma.
ServerA IE,Chrome,Windows Update, Intel driver, Edge, etc...
ServerB Chrome, Nvidia GPU Driver, Edge, etc....
Rather than what it currently is
ServerA IE
Chrome
Windows Update
Intel driver
Edge
etc...
Server B Chrome
Nvidia GPU Driver
Edge
etc....
