Repeat Word in cell and split font style

[Kinngs]

Hi,
I've a code (e.g. BPLIK00049) in cell range A:A

i need this code to be repeated twice in coloumn B:B for barcode printing purpose.
also i need the cell to be split in two different font style
1st in calibri 22 bold
2nd in "Free 3 0f 9" size 22 bold

 

[Michael M]

Hi and welcome to the Board
Are the codes (BPLIK00049) all the same length, eg, 10 characters ?

 

[Kinngs]

Yes Mike!

 

[Michael M]

First up, I dont have the second font, so you will have to modify the line to suit.
Give this a try

Sub modify()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 1 Step -1
    Range("B" & r).Value = Range("A" & r) & " " & Range("A" & r)
    Range("B" & r).Copy
    Range("B" & r).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    With Range("B" & r).Characters(Start:=1, Length:=10).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 22
    End With
    With Range("B" & r).Characters(Start:=12, Length:=10).Font
        .Name = "Freestyle Script"  'change this line to the correct font name
        .FontStyle = "Bold"
        .Size = 22
    End With
Next r
End Sub

 

[Kinngs]

Hey Mike.. Supa thanks it worked perfect...
can i split the codes with alt & enter instead of a space.... pls

Thanks & Regards

 

[Michael M]

Try

Sub modify()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 1 Step -1
    Range("B" & r).Value = Range("A" & r) & vbCrLf & Range("A" & r)
    Range("B" & r).Copy
    Range("B" & r).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    With Range("B" & r).Characters(Start:=1, Length:=10).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 22
    End With
    With Range("B" & r).Characters(Start:=13, Length:=10).Font
        .Name = "Freestyle Script"
        .FontStyle = "Bold"
        .Size = 22
    End With
Next r
Columns("B:B").ColumnWidth = 22
Rows("1:" & lr).RowHeight = 53
End Sub

 

[Michael M]

Another version with the redundant code removed....no need for copy / paste

Sub modify()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 1 Step -1
    Range("B" & r).Value = Range("A" & r) & vbCrLf & Range("A" & r)
    With Range("B" & r).Characters(Start:=1, Length:=10).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 22
    End With
    With Range("B" & r).Characters(Start:=13, Length:=10).Font
        .Name = "Freestyle Script"
        .FontStyle = "Bold"
        .Size = 22
    End With
Next r
Columns("B:B").ColumnWidth = 22
Rows("1:" & lr).RowHeight = 53
End Sub

 

[Kinngs]

Yo... Thanks a ton.... it worked... work easier ... thnx again...

 

[Michael M]

No worries
Thanks for the feedback.