Consulting

Results 1 to 6 of 6

Thread: Solved: Add to Make a String

  1. #1
    Site Admin
    The Princess
    VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location

    Solved: Add to Make a String

    Suppose this:

    I get a file every day that has lists of numbers in column A, beginning in row 2.

    They are ALWAYS 4 digits.
    I would like to append a 6 digit (text) number to the end of these numbers with a macro that pops a msgbox asking me what that 6-digit number is, then, on enter, loops through and changes all the values in column A to append the six digits to the end of them.

    Got me?
    ~Anne Troy

  2. #2
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    You dont want to be looping

    This code doesn't check for input or source length & type. Do you want that?

    [vba]
    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")

    Set Myrange = ActiveSheet.Range(ActiveSheet.Range("A2"), ActiveSheet.Range("A65536").End(xlUp))
    Set Myrange = Intersect(Myrange, ActiveSheet.Cells.SpecialCells(xlConstants))

    With Myrange
    .Offset(0, 1).Columns.Insert
    .Offset(0, 1).FormulaR1C1 = "=Concatenate(RC[-1], """ & Mystr & """)"
    .Offset(0, 1).FormulaR1C1Local = .Offset(0, 1).Value
    .Columns.Delete
    End With

    Application.ScreenUpdating = True

    End Sub
    [/vba]
    Last edited by brettdj; 06-16-2004 at 11:10 PM.

  3. #3
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    This code doesn't check for input or source length & type. Do you want that?
    I don't think so. As for looping, heck...that's just a figger o' speech, right? WRONG! Okay. I won't say that any more.

    I'll make us a sample and you post it under yer name.
    ~Anne Troy

  4. #4
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    LOL

    I tidied up a little on the range select. Note that it will bomb out with formulas - its designed to run on constants only

    You should be in bed

    [vba]
    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")

    Set Myrange = Intersect(ActiveSheet.Range("A:A"), ActiveSheet.Cells.SpecialCells(xlConstants))

    With Myrange
    .Offset(0, 1).Columns.Insert
    .Offset(0, 1).FormulaR1C1 = "=Concatenate(RC[-1], """ & Mystr & """)"
    .Offset(0, 1).FormulaR1C1Local = .Offset(0, 1).Value
    .Columns.Delete
    End With

    Application.ScreenUpdating = True
    End Sub
    [/vba]

  5. #5
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,892
    Location
    You could always go simple...


    [vba]Sub addSix()

    Dim x As Integer
    Dim s As String
    Dim lRow As Integer
    lRow = Range("A65536").End(xlUp).Row
    s = InputBox("Enter the 6 digit number you want to append to column A")
    For x = 2 To lRow
    Range("A" & x).Value = Range("A" & x).Value & s
    Next

    End Sub[/vba]


    Nothin' fancy. An option I guess.

  6. #6
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    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

    [vba]
    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
    [/vba]
    Last edited by brettdj; 06-21-2004 at 09:59 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •