Prevent macro calculate if text in the range

  • Thread starter Thread starter Axel
  • Start date Start date
A

Axel

I tryed to make the macro exit if there has been written text in range
D4:D53, 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("D4:D53")
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
 
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
D4:D53, 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("D4:D53")
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
Click to expand...
 
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.
 
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("D4:D53")
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
 
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("D4:D53")
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
Click to expand...
 
Back
Top