Combining two cells which contain lists

[B1azingPengu1n]

Hey everyone,

I have a large spreadsheet with many pairs of cells like this:

Names Emails

Chris Ritter;Ina Lucas;Tammy Willerth;''''''Eric Willerth'''''';Maya;Regina Bell;Bonita Schaufele;'Marilyn Llewellyn'

ceritter@telus.net; hopelesslyoverbudget@me.com; twillerth@shaw.ca; ewillerth@gmail.com; maya.lijin@gmail.com; reginab@telus.net; bonitaschaufele@shaw.ca; pokeyllew@yahoo.ca <tbody> </tbody>

<tbody>
</tbody>

Obviously these fields match respectively, the first item before the semicolon in the left cell corresponding to the first item in the right.

Is there a way to extract this data so that it's instead many pairs of cells, each with one item? Like this:

Chris Ritter	ceritter@telus.net
Ina Lucas	hopelesslyoverbudget@me.com
Tammy Willerth	twillerth@shaw.ca
Eric Willerth	ewillerth@gmail.com

<tbody>
</tbody>

Thanks in advance for any help!

 

[JoeMo]

This assumes your first data cell is A1 and will place the extracted info from all cells in cols A & B on a new sheet (added by the code) immediately following the source data sheet.

Sub SeparatePairs()
Dim sSht As Worksheet, V1 As Variant, V2 As Variant, i As Long, S1 As Variant, S2 As Variant
Dim j As Long, dSht As Worksheet, ct As Long

Set sSht = ActiveSheet
V1 = sSht.Range("A1:A" & sSht.Cells(Rows.Count, "A").End(xlUp).Row + 1).Value
V2 = sSht.Range("B1:B" & sSht.Cells(Rows.Count, "A").End(xlUp).Row + 1).Value
Application.ScreenUpdating = False
Set dSht = Sheets.Add(after:=ActiveSheet)
For i = 1 To UBound(V1, 1)
    S1 = Split(V1(i, 1), ";")
    S2 = Split(V2(i, 1), ";")
    For j = LBound(S1) To UBound(S1)
        ct = ct + 1
        dSht.Cells(ct, "A").Value = S1(j)
        dSht.Cells(ct, "B").Value = S2(j)
    Next j
Next i
dSht.Columns("A:B").AutoFit
Application.ScreenUpdating = True
End Sub

 

[Ells_]

here's a user defined function that can be used:

Function SplitText(textWithSemicolons As String, substringNumber As Long)

Dim output() As String


output = Split(textWithSemicolons, ";")


SplitText = output(substringNumber - 1)


End Function

the 2nd input is for which index you want to pull (starting at an index of 1)

SplitText(A1,1) returns Chris Ritter
SplitText(A1,5) returns Maya


for help on how to add a user defined function:
https://support.office.com/en-us/ar...cel-2007-2f06c10b-3622-40d6-a1b2-b6748ae8231f

 

[skywriter]

This solution assumes your data was in A1 and B1 and the results are in A2 and down.

The screen shot at the bottom is the results of the code.

Sub CreateEmailAddress()
Dim a, b, c, j As Long
a = Split(Range("A1").Value, ";")
b = Split(Range("B1").Value, ";")
ReDim c(UBound(a), 1)
    For j = LBound(a) To UBound(a)
        c(j, 0) = a(j)
        c(j, 1) = b(j)
    Next j
Range("A2").Resize(UBound(a) + 1, 2).Value = c
End Sub

Excel Workbook
	A	B
1	Chris Ritter;Ina Lucas;Tammy Willerth;''''''Eric Willerth'''''';Maya;Regina Bell;Bonita Schaufele;'Marilyn Llewellyn'	ceritter@telus.net; hopelesslyoverbudget@me.com; twillerth@shaw.ca; ewillerth@gmail.com; maya.lijin@gmail.com; reginab@telus.net; bonitaschaufele@shaw.ca; pokeyllew@yahoo.ca
2	Chris Ritter	ceritter@telus.net
3	Ina Lucas	hopelesslyoverbudget@me.com
4	Tammy Willerth	twillerth@shaw.ca
5	'''''Eric Willerth''''''	ewillerth@gmail.com
6	Maya	maya.lijin@gmail.com
7	Regina Bell	reginab@telus.net
8	Bonita Schaufele	bonitaschaufele@shaw.ca
9	Marilyn Llewellyn'	pokeyllew@yahoo.ca
Sheet2

 

[B1azingPengu1n]

Wow, thanks so much. How can I run this?

 

[JoeMo]

Wow, thanks so much. How can I run this?

To whom are you replying?

 

[B1azingPengu1n]

To whom are you replying?

Oops, hit "Reply" and not "Reply with quote".

I was replying to you, but after a quick Google I figured out how to run your code. It worked beautifully! Thanks so much!

 

[B1azingPengu1n]

here's a user defined function that can be used:

Function SplitText(textWithSemicolons As String, substringNumber As Long)

Dim output() As String


output = Split(textWithSemicolons, ";")


SplitText = output(substringNumber - 1)


End Function

the 2nd input is for which index you want to pull (starting at an index of 1)

SplitText(A1,1) returns Chris Ritter
SplitText(A1,5) returns Maya


for help on how to add a user defined function:
https://support.office.com/en-us/ar...cel-2007-2f06c10b-3622-40d6-a1b2-b6748ae8231f

This solution assumes your data was in A1 and B1 and the results are in A2 and down.

The screen shot at the bottom is the results of the code.

Sub CreateEmailAddress()
Dim a, b, c, j As Long
a = Split(Range("A1").Value, ";")
b = Split(Range("B1").Value, ";")
ReDim c(UBound(a), 1)
    For j = LBound(a) To UBound(a)
        c(j, 0) = a(j)
        c(j, 1) = b(j)
    Next j
Range("A2").Resize(UBound(a) + 1, 2).Value = c
End Sub

Sheet2

*	A	B
1	Chris Ritter;Ina Lucas;Tammy Willerth;''''''Eric Willerth'''''';Maya;Regina Bell;Bonita Schaufele;'Marilyn Llewellyn'	ceritter@telus.net; hopelesslyoverbudget@me.com; twillerth@shaw.ca; ewillerth@gmail.com; maya.lijin@gmail.com; reginab@telus.net; bonitaschaufele@shaw.ca; pokeyllew@yahoo.ca
2	Chris Ritter	ceritter@telus.net
3	Ina Lucas	hopelesslyoverbudget@me.com
4	Tammy Willerth	twillerth@shaw.ca
5	'''''Eric Willerth''''''	ewillerth@gmail.com
6	Maya	maya.lijin@gmail.com
7	Regina Bell	reginab@telus.net
8	Bonita Schaufele	bonitaschaufele@shaw.ca
9	Marilyn Llewellyn'	pokeyllew@yahoo.ca

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:294px;"><col style="width:397.33px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Thanks so much for your help guys, what an awesome forum

 

[JoeMo]

Oops, hit "Reply" and not "Reply with quote".

I was replying to you, but after a quick Google I figured out how to run your code. It worked beautifully! Thanks so much!

You are welcome - thanks for the reply.