Consulting

Results 1 to 6 of 6

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

    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?


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


    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

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

    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

    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

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