Macro that splits content from cell if given character is found
 

I give my example :

Column A : book titles
Column B : authors ( a book may have 1 or more authors which are
separated by a comma - like this : *John Doe , Michael Moore*

Column C , D ,E etc ... information regarding the titles which makes no
difference

The macro should read every cell in B column . If no comma is found
means it is only one author . Macro should copy the content from that
cell ( B1 ... Bn) to H column ( H1 ... Hn )

If 1 comma or more are found , means there are more authors . 1 comma
means there are 2 authors , 2 commas means there are 3 authors ... so on


Say there are 2 commas . The Macro should create 2 rows after the row
analysed with same content . More than that , should put in
corresponding H column the authors one by one . Example


A1: The fugitive B1 : John Doe , Michael Moore , Sasha Wild

The macro should to this :

A1: The fugitive B1 : John Doe , Michael Moore , Sasha Wild H1 :
John Doe
A2: The fugitive B2 : Jonh Doe , Michael Moore , Sasha Wild H2 :
Michael Moore
A3: The fugitive B3 : Jonh Doe , Michael Moore , Sasha Wild H3 :
Sasha Wild


The row number 2 ( A2 , B2 ... ) becomes row number 4 ( A4, B4 ...)
after macro does his job . Of course , it is also analysed by macro and
so on till macro find rows without text where it stops

Can this be done ?


--
andrei
------------------------------------------------------------------------
andrei's Profile: http://www.thecodecage.com/forumz/me...hp?userid=1056
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=147695

Macro that splits content from cell if given character is found
 

Sub text_sep()
Dim r As Integer, i As Integer
Dim counter As Integer, k As Integer
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
r = Cells(Rows.Count, "B").End(xlUp).Row

For i = r To 1 Step -1
j = Split(Cells(i, "B").Value, ",")
counter = UBound(j)
If counter 0 Then
Range("A" & i + 1 & ":H" & i + counter).Select
Selection.Insert Shift:=xlDown
Range("A" & i & ":H" & i + counter).FillDown
End If
l = i
For k = 0 To counter
Cells(l, "H").Value = Trim(j(k))
l = l + 1
Next k
Next i

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

On Oct 25, 10:44*pm, andrei wrote:
I give my example :

Column A : book titles
Column B : authors ( a book may have 1 or more authors which are
separated by a comma - like this : *John Doe , Michael Moore*

Column C , D ,E etc ... information regarding the titles which makes no
difference

The macro should read every cell in B column . If no comma is found
means it is only one author . Macro should copy the content from that
cell ( B1 ... Bn) to H column ( H1 ... Hn )

If 1 comma or more are found , means there are more authors . 1 comma
means there are 2 authors , 2 commas means there are 3 authors ... so on

Say there are 2 commas . The Macro should create 2 rows after the row
analysed with same content . More than that , should put in
corresponding H column the authors one by one . Example

A1: The fugitive *B1 : John Doe , Michael Moore , Sasha Wild

The macro should to this :

A1: The fugitive *B1 : John Doe , Michael Moore , Sasha Wild * *H1 :
John Doe
A2: The fugitive *B2 : Jonh Doe , Michael Moore , Sasha Wild * *H2 :
Michael Moore
A3: The fugitive *B3 : Jonh Doe , Michael Moore , Sasha Wild * *H3 :
Sasha Wild

The row number 2 ( A2 , B2 ... ) becomes row number 4 ( A4, B4 ...)
after macro does his job . Of course , it is also analysed by macro and
so on till macro find rows without text where it stops

Can this be done ?

--
andrei
------------------------------------------------------------------------
andrei's Profile:http://www.thecodecage.com/forumz/me...hp?userid=1056
View this thread:http://www.thecodecage.com/forumz/sh...d.php?t=147695

Macro that splits content from cell if given character is found
 

An alternative.
I did some quick test but did not write error handling. Let me know if you
have issues.
Option Explicit
Sub SplitAuthor()

Dim Authors() As String
Dim WorkRange As Range, TempRange As Range
Dim i As Integer, NumAuthor As Integer
Application.ScreenUpdating = False
'Define the work range
'I assume your first book title resides in A1. You can make change to the
next line if otherwise.
Set WorkRange = Range("a1")
Do While Not IsEmpty(WorkRange) 'loop through all book titles
Authors = (Split(WorkRange.Offset(0, 1).Value, ","))
NumAuthor = UBound(Authors) 'the number of authors: 0=single author

'if more than one author add new lines and fill down data
If NumAuthor 0 Then
Range(WorkRange.Offset(1, 0), WorkRange.Offset(NumAuthor,
0)).EntireRow.Insert
Range(WorkRange, WorkRange.Offset(NumAuthor, 1)).EntireRow.FillDown
End If

'copy the author name into column H
Range(WorkRange.Offset(0, 7), WorkRange.Offset(NumAuthor, 7)).Value _
= Application.WorksheetFunction.Transpose(Authors)
For Each TempRange In Range(WorkRange.Offset(0, 7), _
WorkRange.Offset(NumAuthor, 7))
TempRange.Value = Trim(TempRange.Value)
Next TempRange

'go to the next book title
Set WorkRange = WorkRange.Offset(NumAuthor + 1, 0)
Loop

Application.ScreenUpdating = True
End Sub








"muddan madhu" wrote in message
...
Sub text_sep()
Dim r As Integer, i As Integer
Dim counter As Integer, k As Integer
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
r = Cells(Rows.Count, "B").End(xlUp).Row

For i = r To 1 Step -1
j = Split(Cells(i, "B").Value, ",")
counter = UBound(j)
If counter 0 Then
Range("A" & i + 1 & ":H" & i + counter).Select
Selection.Insert Shift:=xlDown
Range("A" & i & ":H" & i + counter).FillDown
End If
l = i
For k = 0 To counter
Cells(l, "H").Value = Trim(j(k))
l = l + 1
Next k
Next i

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

On Oct 25, 10:44 pm, andrei wrote:
I give my example :

Column A : book titles
Column B : authors ( a book may have 1 or more authors which are
separated by a comma - like this : *John Doe , Michael Moore*

Column C , D ,E etc ... information regarding the titles which makes no
difference

The macro should read every cell in B column . If no comma is found
means it is only one author . Macro should copy the content from that
cell ( B1 ... Bn) to H column ( H1 ... Hn )

If 1 comma or more are found , means there are more authors . 1 comma
means there are 2 authors , 2 commas means there are 3 authors ... so on

Say there are 2 commas . The Macro should create 2 rows after the row
analysed with same content . More than that , should put in
corresponding H column the authors one by one . Example

A1: The fugitive B1 : John Doe , Michael Moore , Sasha Wild

The macro should to this :

A1: The fugitive B1 : John Doe , Michael Moore , Sasha Wild H1 :
John Doe
A2: The fugitive B2 : Jonh Doe , Michael Moore , Sasha Wild H2 :
Michael Moore
A3: The fugitive B3 : Jonh Doe , Michael Moore , Sasha Wild H3 :
Sasha Wild

The row number 2 ( A2 , B2 ... ) becomes row number 4 ( A4, B4 ...)
after macro does his job . Of course , it is also analysed by macro and
so on till macro find rows without text where it stops

Can this be done ?

--
andrei
------------------------------------------------------------------------
andrei's Profile:http://www.thecodecage.com/forumz/me...hp?userid=1056
View this thread:http://www.thecodecage.com/forumz/sh...d.php?t=147695

Macro that splits content from cell if given character is found
 

Just tested muddan madhu macro and it is working ( a brief glance ) .
Thanks !


--
andrei
------------------------------------------------------------------------
andrei's Profile: http://www.thecodecage.com/forumz/me...hp?userid=1056
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=147695