Excel Macro to split and duplicate data

Question

Hi folks. I have an extracted set of data about 12 columns long and 200 rows down. However, in column B they have multiple different values which i would like to seperate into individuals. Example:

"XT 1.1.2: XT 4.2.1: XT 12.2.3" "xxx"

"XT 1.2.2: XT 4.2.2: XT 13.3.4" "txt"

I need to seperate these XTs into individual rows of their own, whilst also duplicating the rest of the data that was on the same row as these grouped XTs from other rows into these separate rows. So basically

Row B.      Row C

"XT 1.1.2"        "xxx" 

"XT 4.2.1"         "xxx"

"XT 12.2.3"      "xxx"

"XT 1.2.2"      "txt"

"XT 4.2.2"     "txt"

"XT 1.3.3.4"     "txt"

I have a bit of experience with excel macros but i am unsure of how to go about something like this. Please assist!

Answer 1

Hi Corbyn

Here a macro that will sort your problem.

Please note:

* It will respond according to the pattern and sequence you wrote. So you might need to do some adjustments if changes arise.

* In this macro row 1 is for headers

************************************************************************************************

Sub SplitAndDuplicateData()

Dim Rp1, Rp2, T As String

Dim C As Variant

Dim Trg() As String

Dim Rng As Range

Dim R As Range

'Here we set the array you want to split

'Please note we assuming ranges in row 1, ie.A1, B1, C1.... are Headers

'Target range is from A2 downwards

Set Rng = Range("A2", Range("A2").End(xlDown))

' Loop though cells in target range.

For Each R In Rng

' Here we replace strings to create groups that contain the strings to split

Rp1 = Replace(R.Value, """ """, """""")

Rp2 = Replace(Rp1, ": ", """""")

' Trimming to clean unwanted spaces.

T = Trim(Rp2)

''' this function will split the string in groups by assigned the delimiter ""

Trg = Split(T, "")

'' ' Please note Trg(UBound(Trg))= last group (portion) in of the string ie. "xxx" or "txt"

''' This part will split string and assign the values to columns B and C

For Each C In Trg

If C <> Trg(UBound(Trg)) Then

Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = C

Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = Trg(UBound(Trg))

End If

Next C

Next R

End Sub

****************************************************************************************************

Hope this will help. Enjoy it.