Concatenate two columns and skip blank cells

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

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

Answer 2

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 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

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 5

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.