Hello,

An action which I do mostly by hand, row for row, perhaps is possible to do automaticly.

In a sheet column A till Z, is in column F in some cases text registered with a 'slash' in between if more then one text occur in the specific cell.

If Cell F contains more textfields, and then there also slashes, then I split it out in identical copied rows, with only in column F the text as standalone separated part.

The basic row stays as it is, only if there are for example 3 slashes in column F then I insert 3 rows below this basic row, copy the complete row, and fill in cell F only that part of the text.
If there are no slashes then no copy action required.

For example.

Row.....ColumnF
2.......aa/bb/cc
3.......dd/ee
4.......ff
5.......gg/hh/ii
6.......jj

results then in

Row1....ColumnF
2.......aa/bb/cc
3.......aa
4.......bb
5.......cc
6.......dd/ee
7.......dd
8.......ee
9.......ff
10......gg/hh/ii
11......gg
12......hh
13......ii
14......jj

If somebody like to solve :)
Then I can stop doing it by hand.

regards, Johan

Hi Johan,

Am Sun, 22 Sep 2019 01:50:57 -0700 (PDT) schrieb JS SL:

The basic row stays as it is, only if there are for example 3 slashes in column F then I insert 3 rows below this basic row, copy the complete row, and fill in cell F only that part of the text.
If there are no slashes then no copy action required.

For example.

Row.....ColumnF
2.......aa/bb/cc
3.......dd/ee
4.......ff
5.......gg/hh/ii
6.......jj

results then in

Row1....ColumnF
2.......aa/bb/cc
3.......aa
4.......bb
5.......cc
6.......dd/ee
7.......dd
8.......ee
9.......ff
10......gg/hh/ii
11......gg
12......hh
13......ii
14......jj

try:

Sub CopyRows()
Dim rngC As Range
Dim varTmp As Variant
Dim LRow As Long, i As Long

Application.ScreenUpdating = False
With ActiveSheet
LRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = LRow To 2 Step -1
If InStr(.Cells(i, "F"), "/") 0 Then
varTmp = Split(.Cells(i, "F"), "/")
.Rows(i).Copy
.Rows(i + 1).Resize(UBound(varTmp) + 1).Insert shift:=xlDown
.Cells(i + 1, "F").Resize(UBound(varTmp) + 1) = _
Application.Transpose(varTmp)
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Why looks life sometimes so nice :)
Claus, thx (again). It really help me out.
regards, Johan

Just a small question......

How to mark the cell column F with the slashes 'green' (that are the one to be copied) and then the one that you splitted out and copied, the cell in column F 'yellow'.
Then it's easy to see which one was the basic (= green) and the copied/splitted ones (=yellow).

reg. Johan

Hi Johan,

Am Sun, 22 Sep 2019 22:56:49 -0700 (PDT) schrieb JS SL:

How to mark the cell column F with the slashes 'green' (that are the one to be copied) and then the one that you splitted out and copied, the cell in column F 'yellow'.
Then it's easy to see which one was the basic (= green) and the copied/splitted ones (=yellow).

change the code to:

Sub CopyRows()
Dim rngC As Range
Dim varTmp As Variant
Dim LRow As Long, i As Long

Application.ScreenUpdating = False
With ActiveSheet
LRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = LRow To 2 Step -1
If InStr(.Cells(i, "F"), "/") 0 Then
varTmp = Split(.Cells(i, "F"), "/")
.Cells(i, "F").Interior.Color = vbGreen
.Rows(i).Copy
.Rows(i + 1).Resize(UBound(varTmp) + 1).Insert shift:=xlDown
With .Cells(i + 1, "F").Resize(UBound(varTmp) + 1)
.Value = Application.Transpose(varTmp)
.Interior.Color = vbYellow
End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Great !! Thx :)