Prevent macro calculate if text in the range

[Axel]

I tryed to make the macro exit if there has been written text in range
D453, but not succeed. can anyone help please?

Sub Add_hours()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:""
Dim r As Range
Dim v As Range
Set v = Range("D453")
Set r = Range("F4:F53")
If Range("D4:53")HERE IS MY PROBLEM!!! Then GoTo errorline Else: GoTo
line1
line1:
r.FormulaR1C1 = "=RC[-2]+RC[-1]"
r.Copy
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
r = ""
v.FormulaR1C1 = "0"
GoTo Lastline
errorline:
MsgBox ("Kun tall")
Lastline:
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub

 

[Dave Peterson]

I'm not sure what written text actually means, but if you wanted to make sure
the range was empty--no values, no text, no formulas, no nothing, you could use:

if application.counta(v) = 0 then
'all the cells are empty
else
'at least one cell has something in it
end if

I tryed to make the macro exit if there has been written text in range
D453, but not succeed. can anyone help please?

Sub Add_hours()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:""
Dim r As Range
Dim v As Range
Set v = Range("D453")
Set r = Range("F4:F53")
If Range("D4:53")HERE IS MY PROBLEM!!! Then GoTo errorline Else: GoTo
line1
line1:
r.FormulaR1C1 = "=RC[-2]+RC[-1]"
r.Copy
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
r = ""
v.FormulaR1C1 = "0"
GoTo Lastline
errorline:
MsgBox ("Kun tall")
Lastline:
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub

 

[Axel]

Thanks for solution. I ment if the user write tekst, not number in the
range.

 

[Dave Peterson]

You can use application.count() to count all the numbers.

And you can use application.counta() to count all the non-empty cells.

Depending on what you want, maybe you could just subtract one from the other and
check to see if the difference is 0.

 

[Axel]

You got me on the right track
Thanks

Sub Add_hours()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="driller"
Dim r As Range
Dim v As Range
Dim c As Range
Set v = Range("D453")
Set r = Range("F4:F53")
Set c = ActiveCell

For Each c In v
If (c) > 24 Then GoTo errorline Else: GoTo line1
line1:
Next c
r.FormulaR1C1 = "=RC[-2]+RC[-1]"
r.Copy
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
r = ""
v.FormulaR1C1 = "0"

GoTo Lastline
errorline:
MsgBox ("Kun tall mellom 0 og 24")
Lastline:
ActiveSheet.Protect Password:="driller", DrawingObjects:=True,
Contents:=True, Scenarios:=True
End Sub

 

[Dave Peterson]

I'm not quite sure how I helped, but glad you got what you wanted working!

You got me on the right track
Thanks

Sub Add_hours()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="driller"
Dim r As Range
Dim v As Range
Dim c As Range
Set v = Range("D453")
Set r = Range("F4:F53")
Set c = ActiveCell

For Each c In v
If (c) > 24 Then GoTo errorline Else: GoTo line1
line1:
Next c
r.FormulaR1C1 = "=RC[-2]+RC[-1]"
r.Copy
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
r = ""
v.FormulaR1C1 = "0"

GoTo Lastline
errorline:
MsgBox ("Kun tall mellom 0 og 24")
Lastline:
ActiveSheet.Protect Password:="driller", DrawingObjects:=True,
Contents:=True, Scenarios:=True
End Sub