Concatenate address lines - optimisation and best practice

Question

I have written the following code to look at a list of addresses. Where address line one (Add1) is a building number on its own it is concatenated with address line two (Add2). For example:

Add1 "10", Add2 "Baker Street"

Becomes:

Add1 "10 Baker Street", Add2 ""

Sub concatenateAddressLines()

Application.ScreenUpdating = False

    Dim lastRowNumber As Long
    lastRowNumber = ActiveSheet.UsedRange.Rows.Count
    Dim currentRowNumber As Long
    currentRowNumber = 0

    Range("1:1").Find("Add1").Select
    ActiveCell.Offset(RowOffset:=1).Activate

Do Until currentRowNumber = lastRowNumber - 1


    If IsNumeric(ActiveCell.Value) Then
        ActiveCell.Value = ActiveCell.Value & " " & ActiveCell.Offset(0, 1).Value
        ActiveCell.Offset(0, 1).Value = ""
        ActiveCell.Offset(RowOffset:=1).Activate
        currentRowNumber = currentRowNumber + 1
    Else
        ActiveCell.Offset(RowOffset:=1).Activate
        currentRowNumber = currentRowNumber + 1
    End If

Loop

End Sub

(Address line one is always named Add1, but the actual column it is in changes for each file.)

I am new to VBA, but I am aware that I should be avoiding using Select and Activate. If anyone can give me some advice on how to improve this code in terms of best practice and/or optimisation it would be much appreciated.

Answer 1

Another alternative is to use an autofilter to find numeric rows then enumerate through these rows. This should be quicker than checking each row with IsNumeric()

Sub ConcatenateAddress()
    On Error GoTo ExitSub
    Application.ScreenUpdating = False

    Dim wsSrc As Worksheet: Set wsSrc = ActiveSheet
    Dim Add1 As Range: Set Add1 = wsSrc.UsedRange.Find("Add1", , xlValues, xlWhole)

    If Not Add1 Is Nothing Then
        Dim Col1 As Long: Col1 = Add1.Column
        Dim LastRow As Long: LastRow = wsSrc.Columns(Col1).Find("*", SearchDirection:=xlPrevious).Row
        Dim LastCol As Long: LastCol = wsSrc.UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

        Range(Add1, Cells(LastRow, LastCol)).AutoFilter Field:=1, Criteria1:=">0", Operator:=xlAnd
        With Range(Cells(Add1.Row + 1, Add1.Column), Cells(LastRow, LastCol))
            For Each Rw In .SpecialCells(xlCellTypeVisible).Rows
                Cells(Rw.Row, Col1) = Cells(Rw.Row, Col1) & " " & Cells(Rw.Row, Col1 + 1)
                Cells(Rw.Row, Col1 + 1) = ""
            Next Rw
        End With
        Range(Add1, Cells(LastRow, LastCol)).AutoFilter
    End If

ExitSub:
    Application.ScreenUpdating = True
End Sub

Answer 2

Using bobajobs suggestion for an array (as it is quicker):

Public Sub ConcatenateAddressLines()

    Dim rAdd1 As Range
    Dim lLastRow As Long
    Dim vValues As Variant
    Dim lCounter As Long

    'Identify the sheet you're using.  All ranges/cells that start with . will reference this sheet.
    'Google "With End With VBA"
    With ThisWorkbook.Worksheets("Sheet1")
        'Find remembers the last settings used, so best to be specific.
        Set rAdd1 = .Range("1:1").Find(What:="Add1", _
                                       After:=.Range("A1"), _
                                       LookIn:=xlValues, _
                                       SearchDirection:=xlNext)
        'Only continue if Add1 is found.
        'An error occurs if you add .Column to the end of the FIND statement  
        'and nothing is found.
        If Not rAdd1 Is Nothing Then
            'Find the last row in the Add1 column.
            lLastRow = .Cells(Rows.Count, rAdd1.Column).End(xlUp).Row
            If lLastRow > 1 Then
                'Put the range values into an array.
                vValues = .Range(.Cells(2, rAdd1.Column), .Cells(lLastRow, rAdd1.Column + 1))

                'Loop through the array and place numeric values and streets in first dimension.
                For lCounter = LBound(vValues) To UBound(vValues)
                    If IsNumeric(vValues(lCounter, 1)) Then
                        vValues(lCounter, 1) = vValues(lCounter, 1) & " " & vValues(lCounter, 2)
                    End If
                Next lCounter

                'Place the values back on the worksheet.
                rAdd1.Offset(1).Resize(UBound(vValues, 1), UBound(vValues, 2)).Value = vValues
            End If
        End If
    End With
End Sub

Answer 3

The first thing I note about this is that you have Application.ScreenUpdating = False without an Application.ScreenUpdating = True at the end, which would be considered bad practice.

However the fact that you felt it necessary to put Application.ScreenUpdating = False in at all is a hint to a big optimisation possibility.

It will (almost) always be faster to do your processing in vba rather than in excel. In this case, that would mean reading the two columns into a vba array, manipulating it in the same way, and reading them back out to excel.

Activesheet.UsedRange is also slightly lax in updating itself, so you may want to use something along the lines of Cells(Rows.Count, 1).End(xlUp).Row instead.

For example, this should be a faster version of your code:

Option Explicit

Sub concatenateAddressLines()
    Dim firstUsedColumnNumber As Long
    firstUsedColumnNumber = ThisWorkbook.ActiveSheet.Range("1:1").Find("Add1").Column
    Dim lastRowNumber As Long
    lastRowNumber = Cells(Rows.Count, firstUsedColumnNumber).End(xlUp).Row
    Dim inputRange As Range
    Set inputRange = Range(Cells(2, firstUsedColumnNumber), Cells(lastRowNumber, firstUsedColumnNumber + 1))
    Dim data() As Variant
    data = inputRange
    Dim i As Long
    For i = LBound(data) To UBound(data)
        If IsNumeric(data(i, 1)) Then
            data(i, 1) = data(i, 1) & " " & data(i, 2)
            data(i, 2) = ""
        End If
    Next i
    inputRange.Value = data
End Sub