Sign in
 
HomeLibraryLearnDownloadsRepositoryCommunityForumsBlog
Script Center >
> 
> 
need a script for combiningg address information

Answered need a script for combiningg address information

  • Friday, August 10, 2012 5:06 PM
     
     
    Sign In to Vote
    0

    *EXCEL 2010 QUESTION*

    So I was assigned to combine some mailing addresses on a form for labels. For two people with different accounts but family members under the same household we want to combine them under one label. for example:

    Tim    Johnson 1244 fox drive  CA 12345

    Sally Johnson 1244 fox drive CA 12345

    *into*

    Tim and Sally Johnson 1244 fox drive CA 12345

    I've been doing this manually, but it would be great to have a macro that

    -when selecting the two rows (or more) and pressing a button,

    -combines both rows into one. Each first name column gets appended onto the other, and duplicate rows are deleted, leaving just one like the example.

    Sorry if this is a little hard to understand. I'd definitely like to take a crack at this now, but am working on a time sensitive assignment, it will have to wait until I'm at home.

    Just curious to see what you guys come up with!

    Thanks.

     

All Replies

  • Tuesday, August 14, 2012 6:34 AM
    Moderator
     
     Answered Has Code
    Sign In to Vote
    1

    Backup you workbook, and try the following sample:

    Copy the following code to your workbook, and as you said, select two or more rows, run this macro.

    You can assign it to a macro button or with a short cut key if you want.

    Sub CombineFirstName()
    Dim strArray
    Dim lngStartRow&, lngRows&, lngLoop&, lngConnLen&
    Dim strTemp$, strResult$
    
    Const CONNECTION_STRING = " and "
    
    lngConnLen = Len(CONNECTION_STRING)
    strArray = Selection.Columns(1).Value
    lngStartRow = Selection.Row
    lngRows = Selection.Rows.Count
    
    If lngRows >= 2 Then
        For lngLoop = 1 To lngRows
            strTemp = Trim$(Selection.Cells(lngLoop, 1).Value)
            
            If lngLoop = lngRows Then
                strResult = strResult & strTemp
            Else
                If strTemp <> "" Then strResult = strResult & strTemp & CONNECTION_STRING
            End If
        Next
        
        If Right$(strResult, lngConnLen) = CONNECTION_STRING Then strResult = Left$(strResult, Len(strResult) - lngConnLen)
        
        Selection.Cells(1, 1).Value = strResult
        Rows(Selection.Cells(1, 1).Offset(1, 0).Row & ":" & Selection.SpecialCells(xlCellTypeLastCell).Row).Delete Shift:=xlUp
    Else
        MsgBox "Please select two rows at least!", vbCritical, "Error"
    End If
End Sub

    Max Meng

    TechNet Community Support

     
  • Wednesday, August 29, 2012 5:16 PM
     
     
    Sign In to Vote
    0

    Hey, this works very well! Just combines the two leftmost fields, and if I have every field separated, works very well. Thanks so much!

    PS-Sorry I took so long to check back on this, didn't think anyone had gotten around to working on it.