Add to Make a String

[brettdj]

My code needs a mod in case the constants range in column A is not continuous. As a consequence be warned that any formulas in Column A will be deleted.

Cheers

Dave

Option Explicit
Sub ConA()
    Dim Myrange As Range, Mystr As String
    Application.ScreenUpdating = False
Mystr = InputBox("Enter the 6 number string to be appended to Column A")
'If there are no constants then an error will be raised.
    On Error Resume Next
    Set Myrange = Intersect(ActiveSheet.Range("A:A"), ActiveSheet.Cells.SpecialCells(xlConstants))
    On Error GoTo 0
'If there are no constants in Column A then exit
    If Myrange Is Nothing Then Exit Sub
With Myrange
    .Offset(0, 1).Columns.Insert
    .Offset(0, 1).FormulaR1C1 = "=Concatenate(RC[-1], """ & Mystr & """)"
    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
    .Columns(1).Offset(0, 1).EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub