Concatenate two columns and skip blank cells - excel

Question

My current spreadsheet has two columns of data I would like to concatenate. In my provided code, I create a column to the right of the columns I would like to combine and then use a FOR loop to combine each value with a ", " between the values. I would like to adjust the code to skip cells/rows without values because now I end up with a ", " in my combined column if the two initial columns had no values.
Public Sub MergeLatLong()
Dim LastRow As Long
Worksheets("Raw_Data").Activate
Columns("AT:AT").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
LastRow = Range("AR" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Cells(i, 46) = Cells(i, 44) & ", " & Cells(i, 45)
Next i
End Sub

Answer 1

Do you need to use VBA? I would recommend using a TEXTJOIN formula (if you have Excel 2016). Assuming your cells in columns AR and AS and the formula in AT.
The parameters for the formula are =TEXTJOIN(delimiter,ingnore_blanks,range)
So the below formula in AT1 would return a concatenation of the two columns for each row with a comma as the delimiter if there is contents in both columns.
=TEXTJOIN(“,”,TRUE,AR1:AS1)
If you are using a version less than 2016. You could just use the following
=AR1&IF(ISBLANK(AS1),””,”, AS1”)
Either of these can be dragged down and you wouldn’t have any extra commas in any rows with a blank in column AS.

Answer 2

The code below should do what you intend. It will enter a blank if both values are missing, the first only (without comma) if the second is missing, and the second only (with leading comma) if the first is missing. You might adjust that part to better suit your needs.
Public Sub MergeLatLong()
Dim Ws As Worksheet
Dim LastRow As Long
Dim Combo As String, Tmp As String
Dim R As Long
' No need to Activate or Select anything!
Set Ws = Worksheets("Raw_Data")
With Ws
.Columns(46).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
LastRow = .Cells(Rows.Count, "AR").End(xlUp).Row
For R = 2 To LastRow
' if you mean the 'Value' it's better to specify the 'Value' property
Combo = Trim(.Cells(R, 44).Value) ' treat Space as blank
Tmp = Trim(.Cells(R, 45).Value) ' treat Space as blank
If Len(Tmp) Then Tmp = ", " & Tmp
If Len(Combo) And Len(Tmp) > 0 Then Combo = Combo & Tmp
Cells(R, 46).Value = Combo
Next R
End With
End Sub
As did #Dude Scott, I also felt that a worksheet function might be more suitable. VBA might have some advantage if it's a very frequently recurring task only.
If the number of entries is large, add Application.ScreenUpdating = False before the For .. Next loop and reset ScreenUpdating to True at the end of the procedure. That will make for significantly better speed.

Answer 3

you could loop through column AR not blank cells only and check for column AS ones content to properly add comma
moreover, avoid Activate/Select pattern and use direct and explicit reference to ranges:
Public Sub MergeLatLong()
Dim cell As Range
With Worksheets("Raw_Data") ' reference wanted worksheet
.Columns("AT:AT").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For Each cell In .Range("AR2", .Cells(.Rows.Count, "AR").End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced sheet column AR cells with some "constant" values
If IsEmpty(cell.Offset(, 1)) Then
cell.Offset(, 2) = cell.Value
Else
cell.Offset(, 2) = cell.Value & ", " & cell.Offset(, 1)
End If
Next
End With
End Sub

Answer 4

2 Columns 2 One
Fast Array Version
Sub MergeLatLong() ' Array Version
Dim vnt1 As Variant ' 1st Array
Dim vnt2 As Variant ' 2nd Array
Dim vntR As Variant ' Result Array
Dim NoR As Long ' Number of Rows
Dim i As Long ' Row Counter
Dim str1 As String ' 1st String
Dim str2 As String ' 2nd String
Dim strR As String ' Result String
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Handle possible error.
On Error GoTo ErrorHandler
With ThisWorkbook.Worksheets("Raw_Data")
' Insert column ("AT") to the right of column ("AS").
.Columns("AT").Insert xlToRight, xlFormatFromLeftOrAbove
' Calculate Number of Rows (Last Used Row - First Row + 1).
NoR = .Cells(.Rows.Count, "AR").End(xlUp).Row - 2 + 1
' Copy values of column "AR" to 1st Array.
vnt1 = .Columns("AR").Cells(2).Resize(NoR)
' Copy values of column "AS" to 2nd Array.
vnt2 = .Columns("AS").Cells(2).Resize(NoR)
End With
' Resize Result Array to size of 1st Array (or 2nd Array).
ReDim vntR(1 To UBound(vnt1), 1 To 1) As String
' Remarks: All arrays are of the same size.
' Loop through rows of arrays.
For i = 1 To NoR
' Write current value in 1st array to 1st String.
str1 = vnt1(i, 1)
' Write current value in 2nd array to 2nd String.
str2 = vnt2(i, 1)
' Check if 1st String is not empty ("").
If str1 <> "" Then ' 1st String is not empty.
' Check if 2nd String is not empty ("").
If str2 <> "" Then ' 2nd String is not empty.
' Concatenate.
strR = str1 & ", " & str2
Else ' 2nd String is empty.
strR = str1
End If
Else ' 1st String is empty.
If str2 <> "" Then ' 2nd String is not empty.
strR = str2
Else ' 2nd String is empty.
strR = ""
End If
End If
' Write Result String to current row of Result Array.
vntR(i, 1) = strR
Next
With ThisWorkbook.Worksheets("Raw_Data").Columns("AT")
' Copy Result Array to Result Range.
.Cells(2).Resize(NoR) = vntR
' Adjust the width of Result Column.
.AutoFit
' ' Apply some additional formatting to Result Range.
' With .Cells(2).Resize(NoR)
' ' e.g.
' .Font.Bold = True
' End With
End With
ProcedureExit:
' Speed down.
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ErrorHandler:
MsgBox "An unexpected error has occurred. Error '" & Err.Number & "': " _
& Err.Description, vbInformation, "Error"
GoTo ProcedureExit
End Sub
Slow Range Version
Sub MergeLatLongRange() ' Range Version
Dim LastRow As Long ' Last Row Number
Dim i As Long ' Row Counter
Dim str1 As String ' 1st String
Dim str2 As String ' 2nd String
Dim strR As String ' Result String
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Handle possible error.
On Error GoTo ErrorHandler
With ThisWorkbook.Worksheets("Raw_Data")
' Insert column ("AT") to the right of column ("AS").
.Columns("AT").Insert xlToRight, xlFormatFromLeftOrAbove
' Calculate Last Used Row using 1st column "AR".
LastRow = .Cells(.Rows.Count, "AR").End(xlUp).Row
' Loop through rows in columns.
For i = 2 To LastRow
' Write value of cell at current row in column "AR" to 1st String.
str1 = .Cells(i, "AR")
' Write value of cell at current row in column "AS" to 2nd String.
str2 = .Cells(i, "AS")
' Check if 1st String is not empty ("").
If str1 <> "" Then ' 1st String is not empty.
' Check if 2nd String is not empty ("").
If str2 <> "" Then ' 2nd String is not empty.
' Concatenate.
strR = str1 & ", " & str2
Else ' 2nd String is empty.
strR = str1
End If
Else ' 1st String is empty.
If str2 <> "" Then ' 2nd String is not empty.
strR = str2
Else ' 2nd String is empty.
strR = ""
End If
End If
' Write Result String to cell at current row in column "AT".
Cells(i, "AT") = strR
Next
' Adjust the width of column "AT".
.Columns("AT").AutoFit
End With
ProcedureExit:
' Speed down.
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ErrorHandler:
MsgBox "An unexpected error has occurred. Error '" & Err.Number & "': " _
& Err.Description, vbInformation, "Error"
GoTo ProcedureExit
End Sub

Answer 5

Here is the code I ended up using, a blend of the responses above. I create some additional code to find the columns with latitude and longitude, that way if the columns were to somehow be rearranged, the program would still be looking at the correct columns for values.
Sub concatenateLatLong()
Dim WS As Worksheet
Dim lastRow As Long
Dim longName As String
Dim longColumn As Long
Dim latName As String
Dim latColumn As Long
Dim latValue As String
Dim longValue As String
Dim i As Long
Set WS = Worksheets("Data")
With WS
lastRow = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'MsgBox "The last row with entered data is " & lastRow
'Find Longitude column
longName = "LONGITUDE"
longColumn = .Rows(1).Find(What:=longName, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'MsgBox "The " & longName & " header is found in column " & longColumn
'Insert a row to the right of the longitude column
.Columns(longColumn + 1).Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeft
'Give new column header "LAT, LONG"
.Cells(1, longColumn + 1).Value = "LAT, LONG"
'Find Latitude column
latName = "LATITUDE"
latColumn = .Rows(1).Find(What:=latName, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'MsgBox "The " & latName & " header is found in column " & latColumn
'Combine latitude and longitude
For i = 2 To lastRow
latValue = Trim(.Cells(i, latColumn).Value)
longValue = Trim(.Cells(i, longColumn).Value)
If Len(longValue) Then longValue = ", " & longValue
If Len(latValue) And Len(longValue) > 0 Then latValue = latValue & longValue
.Cells(i, longColumn + 1).Value = latValue
Next i
End With
End Sub