Stop A Macro In A Code Running If A Cell Value = "" 1

[APElliott]

Hello,

Firstly - I would like to apologises to everyone out there who as help me in the past, and for not showing my thanks in the correct manner. I'm fully up to speed with the Star system now!

I have the following code that works great, but it as to run some macro that take a lot of time to do there stuff (especially the Material Resourse macro).

The thing is I don't really need to run this macro if the cell value in column I is "".

The code basically takes quantities from col E and paste them to col X - it then deletes them from E - then starting from X3 it copies the quantity to E3. It then moves to Y3 and copies some information and pastes it to another sheet (Coins).

The macro then kick in.

After some copy and pasting the code then returns to e3 and deletes the quantity and skips over to X4 and repeats the process.

I hope I explained myself OK.

Here is a copy of the code:

Sub CoinsRoutine()

'Select Quantity Column & Copy
Range("e3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.Copy

'Paste Quantities To Column X
Range(&quot;x3&quot.Select
ActiveSheet.Paste

'Delete Quantities From Column E
Range(&quot;e3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.ClearContents

'Start Loop to Paste Quantities One at a time from Col X to Col E
Range(&quot;x3&quot.Select
Do Until ActiveCell.Value = &quot;&quot;
ActiveCell.Copy Destination:=ActiveCell.Offset(0, -19)

'Copy Item Info ie Volume, Page, Item etc... & Paste On Coins Sheet
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets(&quot;Coins&quot.Select
Columns(&quot;I:I&quot.Select
Selection.Find(What:=&quot;100&quot;, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Select
ActiveCell.Offset(0, -8).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Run Labour Resourse Macro
Application.Run &quot;'4203BoQ.xls'!LabourResourse&quot;

'Run Plant Resourse Macro
Application.Run &quot;'4203BoQ.xls'!PlantResourse&quot;

'Run Material Resourse Macro
Application.Run &quot;'4203BoQ.xls'!MaterialResourse&quot;

'Run Subs Resourse Macro
Application.Run &quot;'4203BoQ.xls'!SubResourse&quot;

'Sort Coins Report
Sheets(&quot;Coins Report&quot.Select
Range(&quot;A1:H1308&quot.Select
Selection.Sort Key1:=Range(&quot;H2&quot, Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Range(&quot;A2&quot.Select

'Copy Resourses
Sheets(&quot;Coins Report&quot.Select
LRow = Range(&quot;A65536&quot.End(xlUp).Row
LCol = Range(&quot;h2&quot.Column
Range(Cells(2, 1), Cells(LRow, LCol)).Select
Selection.Copy

'Paste Resourses To Coins sheet
Sheets(&quot;Coins&quot.Select
Columns(&quot;I:I&quot.Select
Selection.Find(What:=&quot;100&quot;, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Continue loop to copy quants one at a time
Sheets(&quot;BoQ&quot.Select
ActiveCell.Offset(0, -20).ClearContents
ActiveCell.Offset(1, -1).Select
Loop

'Select Quants In Column X & Paste Back To Column E
Range(&quot;x3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.Copy
Range(&quot;e3&quot.Select
ActiveSheet.Paste

'Delete Quants From Col X
Range(&quot;x3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.ClearContents
Range(&quot;e3&quot.Select
End Sub

Here is also a copy of the Material Resourse macro should you need it.

Sub MaterialResourse()
' MaterialResourse Macro
' Macro recorded 11/08/2003 by Andrew Elliott
'

'
Sheets(&quot;Material&quot.Select
[k1] = [l1]
Range(&quot;c2:c820&quot.Select
Selection.Copy
[j2].Select
Selection.PasteSpecial Paste:=xlValues
Dim R As Long
'Loop till R = 820
For R = 2 To 820
'Cells(RowNumber,ColNumber)
Cells(R, 3).FormulaR1C1 = &quot;&quot;
Cells(R, 12).Value = Cells(R, 11).Value
Cells(R, 3).Value = Cells(R, 10).Value
Next R
[a2].Select
Sheets(&quot;Mats Report&quot.Select
Range(&quot;A3:k821&quot.Select
Selection.Sort Key1:=[k3] _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
[a2].Select
End Sub

Thankyou in advance.

Andrew

 

[RamziSaab]

i dont really understand but to stop a macro when the cell is =&quot;&quot; do this:

If cell(r,3) =&quot;&quot; then
exit sub
else
your code
end if

 

[APElliott]

Thanks Ramzi

I've tried this but I must have got something wrong.

It's telling me that the &quot;Sub or Function Is Not Defined&quot;

I've inserted it like this. Have I done the write thing?

I also change the 3 to a 9 because I want it to stop the macro running if the cell value in col I is = to &quot;&quot;.

Is this right?

If cell(R, 9) = &quot;&quot; Then
Exit Sub
Else
'Run Material Resourse Macro
Application.Run &quot;'4203BoQ.xls'!MaterialResourse&quot;
your code
End If

Thanks

Andrew

 

[APElliott]

Cheers Ramzi,

I've been messing around with it and it's working a treat now. This is what I've ended up with:

Sheets(&quot;BoQ&quot.Select
If ActiveCell.Offset(0, -16) = &quot;&quot; Then
Exit Sub
Else
Sheets(&quot;Material&quot.Select
[k1] = [l1]
Range(&quot;c2:c820&quot.Select
Selection.Copy
[j2].Select
Selection.PasteSpecial Paste:=xlValues
Dim R As Long
'Loop till R = 820
For R = 2 To 820
'Cells(RowNumber,ColNumber)
Cells(R, 3).FormulaR1C1 = &quot;&quot;
Cells(R, 12).Value = Cells(R, 11).Value
Cells(R, 3).Value = Cells(R, 10).Value
Next R
[a2].Select
Sheets(&quot;Mats Report&quot.Select
Range(&quot;A3:k821&quot.Select
Selection.Sort Key1:=[k3] _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
[a2].Select
End If
End Sub

Thankyou once again!

Andrew

 

[RamziSaab]

yeah sorry my one was meant to be cells(r,9) = &quot;&quot;

 

[Bowers74]

APElliot,

Just a quick tip. You don't need to have the If...Then...Else...End If built up to stop the procedure from running (it might cause confusion later).

Your first line of code should read:

If ActiveCell.Offset(0, -16) = "" Then Exit Sub

That is enough, if your procedure encounters a blank cell in the cell in the 16th column to the left of the active cell, it will not coninue. If the cell is not blank then it will continue with your code.





If you can't be &quot;The Best&quot;, be the best at what you can!!!

Never say Never!!!
Nothing is impossible!!!

 

[Rougy]

When ever I need to see if a value is equal to &quot;&quot; I use the Trim(value) function. Seems to help.

-----
The death of dogma is the birth of reason.

 

[APElliott]

Tried your suggestion Mike, but I get a Compile error message 'Block If Without End If.

Any ideas?

Thanks

Andrew

 

[Bowers74]

Hi Andrew,

You have to delete the Else and the End If statements, because they are no longer needed.

The If ActiveCell.Offset(0, -16) = &quot;&quot; Then Exit Sub is a one line conditional statement so the syntax is different. It no longer needs the other statements, since it exits the procedure as soon as it receives the False condition.

I'm sorry I didn't mention that before.



If you can't be &quot;The Best&quot;, be the best at what you can!!!

Never say Never!!!
Nothing is impossible!!!

 

[APElliott]

Cheers Mike,

Any ideas on the other thread I started this morning?

&quot;Create An Unknown Sum Formula&quot;

Thanks

Andrew