More formatting

  • Thread starter Thread starter karyoker
  • Start date Start date
K

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
 
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)
 
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
 
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)
 
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....
 
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)
 
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....
 
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)
 
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)
 
Back
Top