Insert "-" In Other Cells On The Same Row If Cell Value Is "SPARE"

Hi All,

I have the code below, but it takes a long time to complete because of the repetitive actions.
Is there a way to make it more efficient?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim circRef As Range
Dim c4 As Range
Set circRef = Range("B32:B71")

If Not Intersect(Target, circRef) Is Nothing Then
    For Each c4 In circRef
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        If Not Target.Value = "SPARE" Then Exit Sub
        If c4.Value = "SPARE" Then
            c4.Offset(, 1).Value = "-"
            c4.Offset(, 3).Value = "-"
            c4.Offset(, 5).Value = "-"
            c4.Offset(, 7).Value = "-"
            c4.Offset(, 10).Value = "-"
            c4.Offset(, 13).Value = "-"
            c4.Offset(, 16).Value = "-"
            c4.Offset(, 25).Value = "-"
            c4.Offset(, 28).Value = "-"
            c4.Offset(, 30).Value = "-"
            c4.Offset(, 32).Value = "-"
            c4.Offset(, 38).Value = "-"
            c4.Offset(, 41).Value = "-"
            c4.Offset(, 45).Value = "-"
            c4.Offset(, 48).Value = "-"
            c4.Offset(, 51).Value = "-"
            c4.Offset(, 54).Value = "-"
            c4.Offset(, 57).Value = "-"
            c4.Offset(, 60).Value = "-"
            c4.Offset(, 63).Value = "-"
            c4.Offset(, 66).Value = "-"
            c4.Offset(, 69).Font.Name = "Arial"
            c4.Offset(, 69).Value = "-"
            c4.Offset(, 70).Value = "-"
            c4.Offset(, 74).Value = "-"
            c4.Offset(, 77).Font.Name = "Arial"
            c4.Offset(, 77).Value = "-"
            c4.Offset(, 78).Font.Name = "Arial"
            c4.Offset(, 78).Value = "-"
            c4.Offset(, 79).Value = "-"
        Else
            c4.Offset(, 1).Value = ""
            c4.Offset(, 3).Value = ""
            c4.Offset(, 5).Value = ""
            c4.Offset(, 7).Value = ""
            c4.Offset(, 10).Value = ""
            c4.Offset(, 13).Value = ""
            c4.Offset(, 16).Value = ""
            c4.Offset(, 25).Value = ""
            c4.Offset(, 28).Value = ""
            c4.Offset(, 30).Value = ""
            c4.Offset(, 32).Value = ""
            c4.Offset(, 38).Value = ""
            c4.Offset(, 41).Value = ""
            c4.Offset(, 45).Value = ""
            c4.Offset(, 48).Value = ""
            c4.Offset(, 51).Value = ""
            c4.Offset(, 54).Value = ""
            c4.Offset(, 57).Value = ""
            c4.Offset(, 60).Value = ""
            c4.Offset(, 63).Value = ""
            c4.Offset(, 66).Value = ""
            c4.Offset(, 69).Font.Name = "Wingdings 2"
            c4.Offset(, 69).Value = ""
            c4.Offset(, 70).Value = ""
            c4.Offset(, 74).Value = ""
            c4.Offset(, 77).Font.Name = "Wingdings 2"
            c4.Offset(, 77).Value = ""
            c4.Offset(, 78).Font.Name = "Wingdings 2"
            c4.Offset(, 78).Value = ""
            c4.Offset(, 79).Value = ""
            
        End If
    Next c4
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End If
End Sub

Any help would be greatly appreciated!

Thanks,
Storm08

Fast answers need visual help. Please read the yellow banner at the top of this page on how to attach a file and a mocked up solution.

Showing extracts of codes isn't as helpful as you might think. Problems raises more questions than answers.

This seems to work quicker:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim circRef As Range
Dim c4 As Range
Set circRef = Range("B32:B71")

If Intersect(Target, circRef) Is Nothing Then Exit Sub
On Error GoTo Error_Exit

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each c4 In Intersect(Target, circRef)
    If c4.Value = "SPARE" Then
        c4.Offset(, 1).Resize(, 79).Value = "-"
        c4.Offset(, 69).Font.Name = "Arial"
        c4.Offset(, 77).Font.Name = "Arial"
        c4.Offset(, 78).Font.Name = "Arial"
    Else
        c4.Offset(, 1).Resize(, 79).Value = ""
        c4.Offset(, 69).Font.Name = "Wingdings 2"
        c4.Offset(, 77).Font.Name = "Wingdings 2"
        c4.Offset(, 78).Font.Name = "Wingdings 2"
    End If
Next 'c4

Error_Exit:
If Err.Number <> 0 Then Debug.Print "ERROR"
On Error GoTo 0
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Difficult to assess. You have all those merged cells, always a (very, very) bad thing.

The choices are:
1. Loop through all the individual cells (original and slow)
2. Fill all the cells in one go (as suggested and quicker)
3. Combine the options. Group the cells by adjusting the offset and resize values.

To be honest, when you refer to C4.Offset(,1) in relation to a merged cell, I’m not entirely sure which cell it means.