More formatting

[karyoker]

I print karaoke books with the artist in column 1 and the song titles in
column2.. Is there a way to move each artists song titles below the
artists name in column 1?

col1 col2 To This Col1
Artist Song1 Artist
Song2 Song1
Song3 Song2
Song3

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = iLastRow To 1 Step -1
If Cells(i, "A").Value <> "" Then
Rows(i + 1).Insert
Cells(i + 1, "A").Value = Cells(i, "B").Value
Else
Cells(i, "A").Value = Cells(i, "B").Value
End If
Cells(i, "B").Value = ""
Next i
End Sub

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

 

[karyoker]

Ok Thanks thats almost there....

Instead of this:

*10Years*
Wasteland
3 DOORS DOWN
Behind Those Eyes
3 DOORS DOWN
Live For Today

I need this:

*10Years*
Wasteland
3 DOORS DOWN
Behind Those Eyes
Live For Today

 

[Bob Phillips]

R u saying the code is creating duplicates, or u weant it tro recognise
duplicates and remove them?

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

 

[karyoker]

Yes trying to remove duplicates... In the example above 3 Doors Down
has 2 songs and would like the dup artist listing removed... I thought
I could format col1 with *BOLD* but when the songs are moved to col1
they are formatted bold too....Actually I would just like the artists
to be underlined...


Thanks....

 

[Bob Phillips]

How about this

Sub Test()

Dim iLastRow As Long
Dim i As Long
Dim iStart As Long
Dim rng As Range

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
iStart = iLastRow
For i = iLastRow To 1 Step -1
If Cells(i, "A").Value <> "" Then
Rows(i + 1).Insert
Cells(i + 1, "A").Value = Cells(i, "B").Value
iStart = i - 1
Cells(i, "A").Font.Underline = True
Else
Cells(i, "A").Value = Cells(i, "B").Value
If Application.CountIf(Range("A" & i & ":A" & iStart), Cells(i,
"A").Value) > 1 Then
If rng Is Nothing Then
Set rng = Rows(i)
Else
Set rng = Union(rng, Rows(i))
End If
End If
End If
Cells(i, "B").Value = ""
Next i
If Not rng Is Nothing Then rng.Delete
End Sub

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

 

[karyoker]

Bob it is So So close!!! It still lists the artists in duplicate...Where
the artist is listed for multiple songs can we delete those rows?

Thanks....

 

[Bob Phillips]

Can you give me an example of the data that I can work on?

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

 

[karyoker]

This is a short list.. Col1 and col2 are the only ones used....


+-------------------------------------------------------------------+
|Filename: Book2.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4265 |
+-------------------------------------------------------------------+

 

[Bob Phillips]

Sub Test()

Dim iLastRow As Long
Dim i As Long
Dim iStart As Long
Dim rng As Range

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
iStart = iLastRow
For i = iLastRow To 2 Step -1
If Cells(i, "A").Value <> Cells(i - 1, "A").Value Then
Rows(i + 1).Insert
Cells(i + 1, "A").Value = Cells(i, "B").Value
iStart = i - 1
Cells(i, "A").Font.Underline = True
Else
Cells(i, "A").Value = Cells(i, "B").Value
End If
Cells(i, "B").Value = ""
Next i
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

 

[karyoker]

Bob you are a Gentleman and a Scholar and I owe you one

Thanks a bunch!!!!

 

[Bob Phillips]

Glad we got there.

Enjoy the music ... but Jim Reeves?

Bob