Split row into multiply rows based on combined values in a cell andthen make the values unique
 

Dear,

If somebody can help me out;

I've got a spreadsheet with in some cases in column A combined values (always separated with ";" )and in some of them only one.

CEll A1= AA12883;BB435;AA3621
CELL A2= AA465
CEll A3= AA62003;BB835

ps. The length could be several characters.
The challange is that all rows should have only one value in it. Then it results in

CEll A1= AA12883
CEll A2= BB435
CEll A3= AA3621

CELL A4= AA465

CEll A5= AA62003
CEll A6= BB835

There's the need for a loop from cell A1 till last used column A.
If the cell contains 2 times ";" then copy the whole row twice below the active row. Now you got 3 indentical rows. Then delete in all the rows the part that shouldn't be there

Perhaps there is a better way to solve then I describe above :).


So please :)
(thanks!!)

regards, Johan

Split row into multiply rows based on combined values in a cell and then make the values unique
 

Hi Johan,

Am Wed, 20 Mar 2019 13:12:01 -0700 (PDT) schrieb :

CEll A1= AA12883;BB435;AA3621
CELL A2= AA465
CEll A3= AA62003;BB835

ps. The length could be several characters.
The challange is that all rows should have only one value in it. Then it results in

CEll A1= AA12883
CEll A2= BB435
CEll A3= AA3621

CELL A4= AA465

CEll A5= AA62003
CEll A6= BB835

if you have a new version of Office you could use TEXTJOIN to join all
cells to 1 string.
Try:

Sub Test()
Dim varData As Variant
Dim LRow As Long
Dim strTmp As String

'Modify sheet name here
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
strTmp = Application.TextJoin(";", 1, .Range("A1:A" & LRow))
varData = Split(strTmp, ";")
.Range("A1").Resize(UBound(varData) + 1) =
Application.Transpose(varData)
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Split row into multiply rows based on combined values in a cell and then make the values unique
 

Hi Johan,

Am Wed, 20 Mar 2019 21:44:35 +0100 schrieb Claus Busch:

Sub Test()
Dim varData As Variant
Dim LRow As Long
Dim strTmp As String

if you have an older version of Excel where TEXTJOIN doesn't work, try:

Sub Test2()
Dim varOut As Variant, varTmp As Variant
Dim LRow As Long
Dim strTmp As String

'Modify sheet name here
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varTmp = Application.Transpose(.Range("A1:A" & LRow))
strTmp = Join(varTmp, ";")
varOut = Split(strTmp, ";")
.Range("A1").Resize(UBound(varOut) + 1) =
Application.Transpose(varOut)
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Split row into multiply rows based on combined values in a celland then make the values unique
 

Op woensdag 20 maart 2019 21:12:12 UTC+1 schreef :

Dear Claus, thanks a lot. It works !!!!!!!!!

regards, Johan

Split row into multiply rows based on combined values in a celland then make the values unique
 

Dear,

Little issue that I didn't see at once. When splitting up in several rows based on the number of values in the cell in column A, the macro doesn't copy the data of this row (in column B till X) to the new created row.

For example;
ColumnA ColumnB ColumnC ColumnD
AA123;BB123;CC123 blabla boeboe tjatja

Should be then;
ColumnA ColumnB ColumnC ColumnD
AA123 blabla boeboe tjatja
BB123 blabla boeboe tjatja
CC123 blabla boeboe tjatja

It has to copy the exist data of the row where it came from.

So please :) (if possible)

regards, Johan

Split row into multiply rows based on combined values in a cell and then make the values unique
 

Hi Johan,

Am Tue, 26 Mar 2019 04:10:25 -0700 (PDT) schrieb :

For example;
ColumnA ColumnB ColumnC ColumnD
AA123;BB123;CC123 blabla boeboe tjatja

Should be then;
ColumnA ColumnB ColumnC ColumnD
AA123 blabla boeboe tjatja
BB123 blabla boeboe tjatja
CC123 blabla boeboe tjatja

try:

Sub Test()
Dim varData1 As Variant, varData2 As Variant, varTmp As Variant
Dim LRow As Long, i As Long, n As Long

n = 1
'Modify sheet name here
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Modify the range here
varData1 = .Range("A1:A" & LRow)
varData2 = .Range("B1:D" & LRow)
For i = LBound(varData1) To UBound(varData1)
varTmp = Split(varData1(i, 1), ";")
.Cells(n, 1).Resize(UBound(varTmp) + 1) = _
Application.Transpose(varTmp)
.Range(.Cells(n, "B"), .Cells(n + UBound(varTmp), "D")) _
= Application.Index(varData2, i)
n = n + UBound(varTmp) + 1
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Split row into multiply rows based on combined values in a celland then make the values unique
 

You are amazing. Thanks !!!
regards, Johan

Split row into multiply rows based on combined values in a celland then make the values unique
 

Minor question....
I'm struckling to get 'OnError resume next' to include (or something like that).

If the cell in column A is empty or there is no splitcode like ";" then the macrocode has to skip this record en go on with the next one.

For example;
A1= AA123;BB123 Then run macrocode
A2= (empty cell, skip running the macrocode take next record)
A3= CC123;DD123 Then run macrocode
A4= EE123 (no splitcode, skip running the macrocode take next record)

regards, Johan

Split row into multiply rows based on combined values in a cell and then make the values unique
 

Hi Johan,

Am Thu, 28 Mar 2019 00:40:25 -0700 (PDT) schrieb :

I'm struckling to get 'OnError resume next' to include (or something like that).

If the cell in column A is empty or there is no splitcode like ";" then the macrocode has to skip this record en go on with the next one.

For example;
A1= AA123;BB123 Then run macrocode
A2= (empty cell, skip running the macrocode take next record)
A3= CC123;DD123 Then run macrocode
A4= EE123 (no splitcode, skip running the macrocode take next record)

try:

Sub Test()
Dim varData1 As Variant, varData2 As Variant, varTmp As Variant
Dim LRow As Long, i As Long, n As Long

n = 1
'Modify sheet name here
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Modify the range here
varData1 = .Range("A1:A" & LRow)
varData2 = .Range("B1:D" & LRow)
For i = LBound(varData1) To UBound(varData1)
If Len(varData1(i, 1)) = 0 Then
.Cells(n, 1) = ""
.Cells(n, 2).Resize(, 3) = Application.Index(varData2, i)
n = n + 1
GoTo Skip
End If
varTmp = Split(varData1(i, 1), ";")
If UBound(varTmp) 0 Then
.Cells(n, 1).Resize(UBound(varTmp) + 1) = _
Application.Transpose(varTmp)
.Range(.Cells(n, 2), .Cells(n + UBound(varTmp), 4)) _
= Application.Index(varData2, i)
n = n + UBound(varTmp) + 1
Else
.Cells(n, 1) = varTmp
.Cells(n, 2).Resize(, 3) = Application.Index(varData2, i)
n = n + 1
GoTo Skip
End If
Skip:
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016