Is there a way to Calculate with a VBA?

[Tony]

I am looking for a way to lock and color a cell based on another cell. But if
the cell is locked i want it to value based on a formula and if it is NOT
locked I want the used to be able to enter any value he/she wants.

I have 24 cells that will need to be formatted this way. So far I formatted
4 of them and my form doesn't populate fast enough. It takes 2+ minutes to
complete. and that's IF it ever does complete. Sometimes there is an error
and the program stops responding. Here is the VBA Script I am using to update
ONE cell.

If Range("C2").Value = 0 Then
ActiveSheet.Unprotect
Range("C4").Locked = True
Range("C4").Interior.ColorIndex = 6
Range("C4").Formula = "=D4/B4"
ActiveSheet.Protect
End If
If Range("C2").Value = 1 Then
ActiveSheet.Unprotect
Range("C4").Locked = False
Range("C4").Interior.ColorIndex = x1none
Range("C4").Formula = "0"
ActiveSheet.Protect
End If

I was thinking there might be a way to link 6 of the cells together since
it's really 4 sets of 6 cells that need to similarly formatted with a
particular formula. Kind of hard to explain. But even with just 1 of each
type of auto formatting the form doesn't work. Is there anything else I can
do to slim down this VBA Script?

 

[Gary Keramidas]

i'm not sure what you want to do, since this is a small sampling.

maybe use an array ("C2","C6","C8") (just guessing here)

Sub test()
Dim arr As Variant
Dim i As Long
arr = Array("C2", "C4", "C6")

For i = LBound(arr) To UBound(arr)
If Range(arr(i)).Value = 0 Then
ActiveSheet.Unprotect
With Range(arr(i)).Offset(0, 2)
.Locked = True
.Interior.ColorIndex = 6
.Formula = "=D4/B4"
End With
ActiveSheet.Protect
End If
If Range(arr(i)).Value = 1 Then
ActiveSheet.Unprotect
With Range(arr(i)).Offset(0, 2).Locked = False
.Interior.ColorIndex = xlNone
.Formula = "0"
End With
ActiveSheet.Protect
End If
Next
End Sub

 

[Gary Keramidas]

sorry, i hit send too soon.
this may work, but i'm not sure where your data is.

Option Explicit

Sub test()
Dim arr As Variant
Dim i As Long
arr = Array("C2", "E2", "F2")

For i = LBound(arr) To UBound(arr)
If Range(arr(i)).Value = 0 Then
ActiveSheet.Unprotect
With Range(arr(i)).Offset(2)
.Locked = True
.Interior.ColorIndex = 6
.Formula = "=" & Range(arr(i)).Offset(2, 1).Address & _
"/" & Range(arr(i)).Offset(2, -1).Address
End With
ActiveSheet.Protect
End If
If Range(arr(i)).Value = 1 Then
ActiveSheet.Unprotect
With Range(arr(i)).Offset(2).Locked = False
.Interior.ColorIndex = xlNone
.Formula = "0"
End With
ActiveSheet.Protect
End If
Next
End Sub