Prevent macro calculate if text in the range

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


*** Sent via Developersdex http://www.developersdex.com ***
 
D

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
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

*** Sent via Developersdex http://www.developersdex.com ***
 
D

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.
 
A

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("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


*** Sent via Developersdex http://www.developersdex.com ***
 
D

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("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

*** Sent via Developersdex http://www.developersdex.com ***
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top