david graham
Active Member
- Joined
- Dec 6, 2007
- Messages
- 345
Anyone know how to modify the code below to replace the current content of each cell with a "0" (instead of clearing it)?
Code:
Dim g As Range, v As Range, vu As Range, c As Range
Set g = Intersect(Range(ActiveSheet.ScrollArea), Columns("D:J"))
If Not g Is Nothing Then
On Error Resume Next
Set v = g.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not v Is Nothing Then
For Each c In v
If Not c.Locked Then
If vu Is Nothing Then
Set vu = c
Else
Set vu = Union(vu, c)
End If
End If
Next c
If Not vu Is Nothing Then
With vu
.ClearContents
.Cells(1).Select
End With
Else
MsgBox "No visible, unlocked cells in scroll area in col G"
End If
Else
MsgBox "No visible cells in scroll area in col G"
End If
Else
MsgBox "Scroll area does not intersect with col G"
End If