Split cell's data in rows - carrying other data as well.

[Deepak Sharma]

Hello Everyone,

I have attached a file, In column no. H (Emails), I have Multiple emails in most of the cells. So I need to split them in rows but other data should be copied as it is in front of every row.
For E.G.
Row no. A2 has two emails in H2, so there should be two rows only. Other data should be copy/pasted as normal, only emails need to split with same other data.
Row no. A3 has twenty emails so there should be twenty rows and so on....

Please see file if this can be done ?

Thanks !!

 

[chirayu]

Sub RowAdder()

Dim emails As Integer
Dim Val As String
Dim STRow As Integer
Dim EndRow As Integer

Range("H2").Select
Do Until IsEmpty(ActiveCell)
    Val = ActiveCell
    emails = Len(ActiveCell) - Len(Application.WorksheetFunction.Substitute(ActiveCell, ";", ""))
    If emails > 0 Then
        STRow = ActiveCell.Row
        For i = 1 To emails
            ActiveCell.Offset(1, 0).EntireRow.Insert shift:=xlDown
        Next i
        EndRow = ActiveCell.End(xlDown).Offset(-1, 0).Row
        Range("H" & STRow) = Split(Val, ";")(0)
        For i = 1 To emails
            Range("H" & STRow + i) = Split(Val, ";")(i)
        Next i
        Range("A" & STRow + 1 & ":G" & EndRow).Formula = "=IF(A" & STRow & "="""","""",A" & STRow & ")"
        Range("I" & STRow + 1 & ":AD" & EndRow).Formula = "=IF(I" & STRow & "="""","""",I" & STRow & ")"
        Range("H" & EndRow + 1).Select
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop

EndRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("A2:AD" & EndRow).Copy
Range("A2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("A1").Select

MsgBox "Macro done", vbInformation, ""

End Sub

 

[bosco_yip]

Try this formula solution.

1] In A15, copied down until blank :

=IFERROR(INDEX(A$2:A$10,AGGREGATE(15,6,ROW(A$1:A$9)/(LEN(H$2:H$10)-LEN(SUBSTITUTE(H$2:H$10,";",""))+1-(RIGHT(H$2:H$10)=";")>=COLUMN($A:$AD)),ROW(A1))),"")

2] In B15, copied across right to G15, then I15 to AB15, all copied down until blank :

=IF($A15="","",VLOOKUP($A15,$A$2:$AB$10,MATCH(B$1,$A$1:$AB$1,0),0))

3] In H15, copied down until blank :

=IF($A15="","",TRIM(MID(SUBSTITUTE(";"&VLOOKUP($A15,A$2:H$10,8,0),";",REPT(" ",600)),COUNTIF($A$15:$A15,$A15)*600,600)))

Regards
Bosco

 

[KN SRINIVAS]

Hello Everyone,

I have attached a file, In column no. H (Emails), I have Multiple emails in most of the cells. So I need to split them in rows but other data should be copied as it is in front of every row.
For E.G.
Row no. A2 has two emails in H2, so there should be two rows only. Other data should be copy/pasted as normal, only emails need to split with same other data.
Row no. A3 has twenty emails so there should be twenty rows and so on....

Please see file if this can be done ?

Thanks !!

I need reverse of this,
I want to add data from multiple rows to a single row. Please share the solution

 

[bosco_yip]

I need reverse of this,
I want to add data from multiple rows to a single row. Please share the solution

Hi,

Don't hijack the other person's post as this post OP hasn't replied yet whether his question solved or not.

Please open a new post to this forum regarding your question together with the attachment and the expected result.

Regards
Bosco

 

[Deepak Sharma]

Wow! Thank you so much Bosco & chirayu....
@Bosco - Yes it worked wonderfully! I had very large data so applied your formulas and edited them accordingly. It worked like anything....Thank youuuuu for your time dear!!!!

@chirayu - Thank you for your time spent on code I had also pasted your code to module and I think it needs little editing for just row last row only because If last row has only one email then it's working perfectly, If more than 1 then showing some error when it jums through offset. BUT Marvelous work done !!

I have attached file If anyone wants to look.

Thank You so much Both of You Guys !!!!!!!!

Regards,