Changing my VBA to effect a range of cells

[cjcass]

Hi,
Hope you might be able to help me with this. I have the following code (see below) that effectively concatenates 3 cells (A1, B1 & C1) adding dividers and putting the result into D1. It also applies font bolding to the A1 and C1 bits.
What would the code be to run this macro for all cells 100 rows down; so getting it to enter the results into cells D1 to D100 for all the corresponding values in columns A,B&C?
Many thanks,
C.

Sub Macro1()


Dim Part1Len, Part2Len, DividerLen As Integer
Dim Divider As String
Part1Len = Len(Range("A1")) + 2
Part2Len = Len(Range("B1"))
Part3Len = Len(Range("C1"))
Divider = " - "
DividerLen = Len(Divider)


Range("D1") = "[" & Range("A1") & "]" & Divider & Range("B1") & Divider & Range("C1")
With Range("D1").Characters(Start:=1, Length:=Part1Len).Font
.FontStyle = "Bold"
With Range("D1").Characters(Start:=Part1Len + DividerLen + Part2Len + DividerLen, Length:=Part3Len).Font
.FontStyle = "Bold"
With Range("D1").Characters(Start:=Part1Len + DividerLen + 1, Length:=Part2Len).Font
.FontStyle = "Regular"
End With
End With
End With


End Sub

 

[BarryL]

try

Sub Macro1()

 Dim Part1Len, Part2Len, DividerLen As Integer, i As Long
 Dim Divider As String
 For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
 Part1Len = Len(Range("A" & i)) + 2
 Part2Len = Len(Range("B" & i))
 Part3Len = Len(Range("C" & i))
 Divider = " - "
 DividerLen = Len(Divider)

 Range("D" & i) = "[" & Range("A" & i) & "]" & Divider & Range("B" & i) & Divider & Range("C" & i)
 With Range("D" & i).Characters(Start:=1, Length:=Part1Len).Font
 .FontStyle = "Bold"
 With Range("D" & i).Characters(Start:=Part1Len + DividerLen + Part2Len + DividerLen, Length:=Part3Len).Font
 .FontStyle = "Bold"
 With Range("D" & i).Characters(Start:=Part1Len + DividerLen + 1, Length:=Part2Len).Font
 .FontStyle = "Regular"
 End With
 End With
 End With
Next
 End Sub

 

[cjcass]

That works great, thank you very much!!

 

[BarryL]

Glad to help

 

[JackDanIce]

Make a copy of your workbook and replace all of your existing code with below, then try:

Sub Macro1()


    Dim x       As Long
    Dim y       As Long
    Dim str     As String
    Dim temp    As String
    Const delim As String = " - "
    
    str = "[@1]" & delim & "@2" & delim & "@3"
    
    Application.ScreenUpdating = False
    
    For x = 1 To Cells(Rows.Count, 1).End(xlUp).row
        temp = str
        For y = 1 To 3
            temp = Replace(temp, "@" & CStr(y), Cells(x, y).Value)
            temp = Replace(temp, "@" & CStr(y), Cells(x, y).Value)
            temp = Replace(temp, "@" & CStr(y), Cells(x, y).Value)
        Next y
        
        Cells(x, 4).Value = temp
        FormatCell Cells(x, 4), delim
        
        temp = vbNullString
    Next x
    
    Application.ScreenUpdating = True
    
End Sub
Private Sub FormatCell(ByRef rng As Range, ByRef delim As String)


    Dim arr(1 To 3) As Long
    Dim x           As Long
    
    With rng
        .Characters.Font.FontStyle = "Regular"
        For x = 1 To 3
            arr(x) = Len(.Offset(, -4 + x).Value)
            If x <> 3 Then arr(x) = arr(x) + Len(delim)
        Next x
        arr(1) = 2 + arr(1)
        
        .Characters.Font.FontStyle = "Bold"
        .Characters(arr(1) + 1, arr(2)).Font.FontStyle = "Regular"
        
    End With
    
    Erase arr
    
End Sub

Nevermind, Barry beat me to it!