none
How can I write a macro to copy data in a column where multiple email addresses into a newly inserted row? RRS feed

  • Question

  • How to write vba to copy a cells contents if there are multiple email address and delete a colon and insert a new row and paste the descending email addresses in the same column on the newly inserted row?

    Sounds really funky and I wouldn't know the first thing on how to figure it out. Essentially Column O has a few rows with multiple email addresses separated by a colon. I'd love to figure out a macro to look to those rows with multiple email addresses in column O and cut out the descending email addresses and paste them individually to a newly inserted row and deleting the colons. 

    I'll need to do this for multiple columns after this is completed so rather than do this individually row by row for 10,000 plus rows I was hoping to get some assistance. 

    Monday, February 19, 2018 9:03 PM

All replies

  • I think you want to split one cell into multiple cells, right.

    Option Explicit
     
    Const ANALYSIS_ROW As String = "O"
    Const DATA_START_ROW As Long = 2
     
    Sub ReplicateData()
        Dim iRow As Long
        Dim lastrow As Long
        Dim ws As Worksheet
        Dim iSplit() As String
        Dim iIndex As Long
        Dim iSize As Long
     
        'Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
     
        With ThisWorkbook
            .Worksheets("Sheet1").Copy After:=.Worksheets("Sheet1")
            Set ws = ActiveSheet
        End With
     
        With ws
            lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
        End With
     
     
        For iRow = lastrow To DATA_START_ROW Step -1
            iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",")
            iSize = UBound(iSplit) - LBound(iSplit) + 1
            If iSize = 1 Then GoTo Continue
     
            ws.Rows(iRow).Copy
            ws.Rows(iRow).Resize(iSize - 1).Insert
            For iIndex = LBound(iSplit) To UBound(iSplit)
                ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
            Next iIndex
    Continue:
        Next iRow
     
        Application.CutCopyMode = False
        Application.Calculation = xlCalculationAutomatic
        'Application.ScreenUpdating = True
    End Sub




    MY BOOK

    Monday, February 19, 2018 9:48 PM
  • Wow thanks for the quick response. I did get an error however. 
    Monday, February 19, 2018 11:24 PM

  • Ok, I guess your data is not on the sheet named 'Sheet1'.  Just change the name of that sheet you are working with to 'Sheet1' (without quotes).  Or, change the 'Sheet1' that you highlighted to the actual name of the sheet that your data is Good luck.

    MY BOOK

    Tuesday, February 20, 2018 12:57 AM
  • Haha I'm a dummy. The macro did get held up on another section of the code. It got a lot further a long this time until it errored. 

    

    Tuesday, February 20, 2018 11:42 AM
  • It's kind of hard to see the image.  I think posting actual data would be better than posting an image in this case.  Anyway, it looks like the items in Col) are separated by the ';' character.  If so, cheange this:

    iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",")

    To this:

    iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ";")


    MY BOOK

    Wednesday, February 21, 2018 4:19 PM