Automation error ошибка vba

VBA Automation Error

In this Article

This tutorial will explain what a VBA Automation Error means and how it occurs.

Excel is made up of objects – the Workbook object, Worksheet object, Range object and Cell object to name but a few. Each object has multiple properties and methods whose behavior can be controlled with VBA code. If the VBA code is not correctly programmed, then an automation error can occur. It is one of the more frustrating errors in VBA as it can often pop up for no apparent reason when your code looks perfectly fine!

(See our Error Handling Guide for more information about VBA Errors)

Referring to a Variable no Longer Active

An Automation Error could occur when you are referring to a workbook or worksheet via a variable, but the variable is no longer active.

When we run the code above, we will get an automation error. This is due to the fact that we have opened a workbook and assigned a variable to that workbook. We have then closed the workbook but in the next line of code we try to activate the closed workbook. This will cause the error as the variable is no longer active.

If we want to activate a workbook, we first need to have the workbook open!

Memory Overload

This error can also sometimes occur if you have a loop and you forget to clear an object during the course of the loop. However, it might only occur sometimes, and not others- which is one of the reasons why this error is can be so annoying.

Take for example this code below:

The variable is declared as an Object, and then the SET keyword is used to assign an image to the object. The object is then populated with an image and inserted into the Excel sheet with some formatting taking place at the same time. We then add a loop to the code to insert 100 images into the Excel sheet. Occasionally this causes an automation error, but sometimes it doesn’t – frustrating, right?

The solution to this problem is to clear the object variable within the loop by setting the object to NOTHING – this will free the memory and prevent the error.

DLL Errors and Updating Windows

Sometimes the error occurs and there is nothing that can be done within VBA code. Re-registering DLL’s that are being used, making sure that our Windows is up to date and as a last resort, running a Registry Check as sometimes the only things that may work to clear this error.

A good way of avoiding this error is to make sure that error traps are in place using the On Error Go To or On Error Resume Next routines.

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!

VBA Code Examples Add-in

Easily access all of the code examples found on our site.

Simply navigate to the menu, click, and the code will be inserted directly into your module. .xlam add-in.

Источник

Automation error ошибка vba

Вроде как на ровном месте (т.е. до сегодня пару лет работало) вот такая строчка кода:

Set fs = CreateObject(«Scripting.FileSystemObject»)

стала вызывать вот такую ошибку:

Run-time error ‘-2147024770 (8007007e)’:
Automation error

Собственно, это использовалось для последующей проверки ссуществования файла (FileExists). И вот.
Подскажите, пожалуйста, что тут может быть? Библиотеки слетели? Куда смотреть?

Originally posted by rtttv
[b]Собственно, это использовалось для последующей проверки ссуществования файла (FileExists). И вот…

Так всегда происходит , когда люди пренебрегают родными функциями и используются посторонние библиотеки.

Посмотрите, есть ли ссылки на библиотеки Microsoft Scripting Runtime

Спасибо. Именно это — Microsoft Scripting Runtime! Сбилась (в системе) регистрация библиотеки scrrun.dll. А в Excel (Tools — References) «галка» на неё и не стояла. И сейчас не стоит, но всё работает!Т.е. системные библиотеки сами подтягиваются? А вообще в такой ситуации нужно устанавливать reference?

Так всегда происходит , когда люди пренебрегают родными функциями и используются посторонние библиотеки.

Originally posted by rtttv
[b]А в Excel (Tools — References) «галка» на неё и не стояла. И сейчас не стоит, но всё работает

Это кстати, позволяет избежать проблем, связанных с различными версиями (при передаче файла другим лицам)

что Naeel Maqsudov предлагал . Application.Run

Первоисточник конечно всегда лучше, но это действительно было давно, к тому же, на другом форуме, да и ответ был довольно краток и сводился к тому, что вызывать процедуры можно так :

Источник

VBA Automation Error — possibly born from my complete lack of understanding with Error Handling

RockandGrohl

Well-known Member

Hi all, same kind of topic again. Going to start with a top-to-bottom list of nomenclature

Super Automation — Main workbook which contains a list of newspapers and their requirements, houses all macro code
Automation Hub — Where products are placed and ranked according to various criteria
Advert Data — CSV database containing a list of all products and all advertisements, one line per (this is now approaching 30,000 lines)
Various supplementary files that aid in the Automation Hub such as Regional Press Report, Weekly report, etc.

And here’s what happens:

• We have approximately 600-650 newspaper titles each week. A title is selected and SUPER AUTOMATION is initiated.
• Information is brought into a temp sheet and a progress box is opened to display current progress.
• Advert Data is opened and a list of suitable products is found
• The products are sent to Temp sheet, then loaded into Automation Hub
• Various supplementary sheets are opened to aid Automation Hub into determining the best product for the newspaper
• The products are ranked and sent back to the temp sheet, Automation Hub then closes.
• Now that the rank is ascertained, the top X products as required for the advert are allocated
• The Advert Data is opened and the newspaper information is added to that product
• The Advert Data is then saved and closed
• The Super Automation saves and that’s one loop completed out of 600+

The problem:

Somewhere within those red lines, I am getting an error message pop up that crashes Excel. It says «Automation Error» and that’s it. No code, the VBA window doesn’t display where the error is, and if I press «OK» Excel just closes and reopens. I can then press SUPER AUTOMATION again and it will continue on as if nothing happened. It will carry on for 1, 2, 5, 10 or even 100 iterations, then it will crash again, without warning and with no explanation.

Sometimes the Macro will just stop running silently and I still have full control of the sheet, so I can restart it again. This is what leads me to believe it’s an on error.

Solutions I’ve tried:

• Removing all macros from Automation Hub.xlsm and saving to .xlsx
• Doing all Office Updates
• Running files as Admin
• Keeping the Super Automation file on the system drive instead of a network drive
• Crying
• Stepping through code line by line (and it works perfectly)
• Stepping through code in portions (and it works perfectly)
• Praying
• Commenting out «On Error _____» segments, but there are situations outside of my control, like looking for a sheet that may be missing.

I think it may be my poor usage of On Error. In summary, I want this sheet to run overnight, so if there’s a problem with any one of the 600+ rows, I’d rather it just skips that row and I can deal with it in the morning. I’d rather it does 400 with 200 skipped errors, instead of getting to row 30 then copping out and I then have to do another 570.

So in any places where I think there could be an error (for example, no applicable products to transfer from Advert Data to Temp sheet) I want it to «GoTo Skip» and just skip over everything, the «Skip:» portion is literally just return to main tab, iterate to the next line down, repeat.

Below is my code, and I think the error is manifesting itself in the «Call: Super Automation» portion, so I’ve posted that too. Sorry for the mammoth posting.

Источник

Automation error ошибка vba

прошу помочь!
Выскочила такая «бяка» при запуске ранее рабочего макроса. Подозреваю, что что-то с настройками самого Ёкселя (либо ВБА), поскольку эксельный файл с этим макросом даже не хочет сохраняться («Документ не сохранен»). Хотя файлы с другими макросами вполне работоспособны. Офис-2003, в настройке безопасности доверялки подключены.

зы. Сколько уж зарекался оставлять свой комп коллегам

Automation error (Error 440)

When you access Automation objects, specific types of errors can occur. This error has the following cause and solution:

An error occurred while executing a method or getting or setting a property of an object variable. The error was reported by the application that created the object.
Check the properties of the Err object to determine the source and nature of the error. Also try using the On Error Resume Next statement immediately before the accessing statement, and then check for errors immediately following the accessing statement.

ошибка при установке (получении) свойств обьекта.
рекомендуют использовать On Error Resume Next чтобы в свойствах Err получить более детальную информации о произошедшем.

автору на заметку — это не решит проблемы, но должно поднять настроение. при первом прочтении — я плакал.

Источник

Automation error ошибка vba

This forum has migrated to Microsoft Q&A. Visit Microsoft Q&A to post new questions.

Asked by:

Question

I have worked on a file for long time using Excel 2003. I have few macros and custom functions written. I decided to use another computer to do some additional work on this file — mainly new formulas and outline, but no code writing. The file was opened as 2003 and was saved in the same fashion, was not converted to 2007 at any point.

I saved it and closed it. I then opened it on my original computer and after opening it gave me «Automation Error — Catastrophic Failure» message without an error number. Right after that it sent me to VBA screen and instead of having my file name under the Project Tree, it has «VBAproject». I click on it and can see my code and my forms, but the worksheets are not label properly plus they have this little blue icon next to them.

I tried to open the file again by clicking Disable macros, and no error was given but obviously can’t do much with the file.

One thing I read around is about sharing and references. This file sharing options were turned off so that’s not it. I then realized under VBA-Tools-References that the office 2007 is referencing different files for some of the selections, like Visual Basic For Applications, Microsoft Excel 12.0 Object Library, etc. I copied those files to the proper folders on the 2003 computer but that didn’t do the trick. When I click disable macros and go to check the references in the 2003 version everything looks normal.

Any ideas? I did quite of work on this file so redoing this is the last resort but I hope I don’t have to go that route.

Thank you in advance!

Automation errors usually occur when a workbook is trying to run some macro that contains objects they are not included in the references section of the VBA editor. One example that would produce this is having some controls on a form which require a specific DLL to be correctly registered on a client PC. If these DLLs are on your pc, the workbook is fine. Put this same workbook on another PC without the DLLs, and an automation error will occur.

Hope this helps.

Thank you Jennifer,

So tell me what is the best way to check what dll is crashing? Should I simply check which files are referenced in the VBA-Tools-References and see of those files are on the other computer?

Whilst it might be a reference issue what you describe seems much more serious than the usual problems associated with a missing or incompatible reference.

It’s not clear from your original description which Excel version you are currently using, though I assume 2007 as you mentioned «12.0» in the references. FWIW those references are normal, indeed all project will include the following as default

Visual Basic For Applications
Microsoft Excel x.0 Object Library
OLE Automation
Microsoft Office x.0 Object Library
and possibly if a form has ever been added —
Microsoft Forms 2.0 Object Library

where x refers to the Excel version.

Can you open the file in Safe mode, from the Run command
«excel.exe /safe» without quotes
(you might then need to change security settings via the UI to open a file with VBA)

Can you open the file in Excel 2003

Is there anything you can think of in the file that’s not typical about the xls/a(?) originally saved in 2003.

Regards,
Peter Thornton

Hello Peter and thank you for the response.

I am opening the file with Excel 2003 (on Windows XP if it matters). I have worked on this file for long time and just recently did some cosmetic work on Excel 2007 on another computer. I did some VBA coding at that point but it was minor and primarily for formatting help.

The issue is that now I open the file in 2003 and gives me the error. What is even more absurd, I re-worked an old file (which was never opened on 2007) and that file still gives the same error on few of my company’s computers that are all running on 2003.

The current references look like this:

Visual Basic For Applications
Microsoft Excel 11.0 Object Library
OLE Automation
Microsoft Office 11.0 Object Library
Microsoft Forms 2.0 Object Library

I was able to uncheck the 3rd and 4th of these but still the file gives an error. When I open the file on 2007 the 11.0 becomes 12.0 and no other changes.

I can’t think of any special references since all my work has been done on 2003 with few minor changes in 2007. This error drives me crazy since I can’t do anything with the file. I will try this safe mode opening. I have never opened a file through VBA but will try.

When you round trip a VBA file saved on an old version to a new, and back again reference problems can be introduced, even if you haven’t done anything apart from save.

That occurs when the reference has been updated to the new version then not found in the old version’s system. Whilst that can make some VBA stuff fail, normally not with the serious consequences you described. However the ref’s you show this time look fine for the file when opened in 2003, indeed exactly what I’d expect. Actually I’m surprised you were able to remove two of the ref’s.

The cosmetic changes you made in 2007 sound like formats, some of these may cause problems when reopened in 2003, though normally the compatibility checker will pick these up.

I’m a bit confused though, if I follow you are saying you’ve got problems with a file that’s never even been opened in 2007. Also if I follow the exact same file opens fine in some 2003 systems but not in others. Does the file include any non standard forms controls, any controls that you would have needed to add to the toolbox for example.

Regards,
Peter Thornton

Sorry to confuse you here — I am talking about 2 files.

First file — was used in 2003, then saved and more formatting work was done on 2007, after that this file crashed on my personal computer and one my coworker’s as well. We can says this «round-trip» is the cause.

The second file is technically a copy of the first before it was opened on 2007. I re-did all of the work that I previously did on 2007 on my 2003 excel and that file is works fine on my computer but is crashing on some of my coworkers computers. This file was never opened on 2007.

Got me thinking though — I have loaded some custom toolbars on my excel that I am not sure all people within my company have. I don’t know if I am going in the wrong direction here. Still I got a file now that I can open along with 2-3 other co-workers, but majority of the people can’t and this file was not opened on 2007 but the error (at least the message) is exactly the same as the error I myself was getting when doing this 2003-2007 round trip.

Curiouser and curiouser!

Do you have an original copy of the file that you neither modified in 2007 nor 2003, if so does that work on all machines.

Are there any Links ?

Any non standard controls that would have needed to be added to the Toolbox ?

Can you open the problematic files on the problematic machines in Safe Mode (see my first post) ?

Any references marked MISSING ?

Any Open event code, if so hold Shift when opening.

Custom Toolbars, do you mean «attached» to the workbook or created on demand. FWIW I really think best never to «attach» custom toolbars, instead create the custom toolbar in the workbook’s open event and delete in the close. That said I can’t think of any reason for a custom toolbar to cause the problems you described.

Regards,
Peter Thornton

Glad I got your curiosity! 🙂

The file I worked on from scratch over a year now. It was always done on 2003.

If you mean links to outside sources — no. There are hyperlinks within the file itself, but nothing fancy on that end.

I don’t think any non-standard controls are added to the Toolbox.

I can open even the file that crashes on my computer by selecting Disable Macros. I tried the safe mode as well with the file that always crashes and besides the message that the macros are disabled in the beginning everything else is fine. So I assume all my coworkers would be able to open it with Safe mode as well.

No MISSING references. Unless it is hiding somewhere else, but I would assume the error message would let me know that.

No Open event code — that includes all of the tabs as well and no change event code.

The custom toolbars are widely used by my company and never caused many errors. But you are right, I don’t think that is the error.

I would gladly send you the file, but it is full with company information. What is even more annoying is that I work in a different location from the rest of my coworkers that have issues with this file so I can’t see what is going on there.

Before I did the changes with 2007, a month ago I had this issue — after my regular update on the file, the other person tried to open the file but got the same error. This was the first time when we faced that error. While waiting for him to hear from IT, I did some more updates to the file (didn’t remove anything old and didn’t add any code) and sent him the most recent copy. Suddenly it worked for him. Bizarre! 2 weeks later I did the updates on 2007 and I got the same error myself. For a year working with this file neither of us had any problems. It just recently started. I think it must be something not necessary related to this file, but rather with my excel, which was activated by another file and this file doesn’t like it. Is that too crazy of an idea?

Источник

One of the more frustrating errors to occur in VBA is the Automation Error.  It can often pop up for no apparent reason despite your code looking perfect.

Reasons for This Error

There are a variety of reasons that this can occur.

Microsoft Office is made up of Objects – the Workbook object, Worksheet Object, Range object and Cell object to name just a few in Excel; and the Document Object in Word.  Each object has multiple properties and methods that are able to be programmed to control how the object behaves. If you do not program these methods correctly, or do not set a property correctly, then an automation error can occur.

It can be highly annoying as the code will run perfectly for a while, and then suddenly you’ll see this!

You may get a number of different messages for this error.

The Object Has Disconnected from Its Client

An automation error could occur when you are referring to a workbook or worksheet via a variable, but the variable is no longer active.  Make sure any object variables that you are referring to in your code are still valid when you call the property and methods that you are controlling them with.

Excel Error Load Form

An automation error could occur within Excel if you load a form while another object (like the worksheet or range object) are still referenced.  Remember to set your object references to NOTHING after you have finished writing the code to control them with.

Error Hiding/Unhiding Sheets In Excel

There are 3 ways to control the visible property in an Excel sheet in VBA – xlSheetVisible, xlSheetHidden or xlSheetVeryHidden.   An automation error could occur if you are trying to write information to a sheet which has the xlVeryHidden property set – make sure you set the sheet to visible in the code before you try to write anything to the sheet using Visual Basic Code.

Error 429 and 440

If you receive either of these errors, it can mean that your DLL files or ActiveX controls that you might be using are not correctly registered on your PC, or if you are using an API incorrectly.  It can also occur if you are running using 32-bit files on a 64-bit machine, or vice versa. 

Automation Error When Running Macro Enabled Workbook Over A Network

If you have a workbook open over a network, and you get an automation error when you run a macro, check your network connections – it could be that the network path is no longer valid.   Check you network paths and connections and make sure that they are all still working.

ADODB Automation Error

This error can occur when you are programming within Microsoft Access and are using the ADODB.Connection object.  It can be caused by any number of reasons from conflicting DLL files to a registry corruption, or simply that you did not set the recordlist object to nothing when you were finished using it!

Common Causes and Things to Check

Here are some reasons you might be getting the error. Perhaps you are…

• Trying to write information to hidden sheets or cells.
• Trying to write information to other documents or workbooks.
• Referring to objects that do not exist.
• Needing to install an update to Office, or the correct .Net framework.
• Loading objects (like pictures) into memory using a loop, and failing to clear the memory between each load (set Pic = Nothing).
• A Corrupt Registry – this is a hard one, as it often means that you need to remove Office entirely from your machine and then re-install it.  

Ways to Solve It

Error Trapping

Error trapping is one of the best ways to solve this problem.  You can use On Error Resume Next – or On Error GoTo Label – depending on your needs at the time.  If you want the code to carry on running and ignore the error, use On Error Resume Next.  If you want the code to stop running, create an error label and direct the code to that error label by using On Error GoTo label.

Clear the Memory

Another way to solve the problem is to make sure you clear any referred objects either in a loop or at the end of your code.  For example, if you have referred to a picture object, set the picture object to NOTHING, or if you have referred to a Worksheet object, set the Worksheet object to NOTHING once you have run the code for that picture of worksheet.

The code example below will insert a picture into a worksheet.  It may or may not give you an automation error!

Sub InsertPicture()
	Dim i As Integer
	For i = 1 To 100
		With Worksheets("Sheet1")
 		Set shp = .OLEObjects.Add(ClassType:="Forms.Image.1", _
 		Link:=False, DisplayAsIcon:=False, Left:=.Cells(i, "A").Left
		, Top:=.Cells(i, "A").Top, Width:=264, Height:=124)
 		End With
		 With shp
			.Object.PictureSizeMode = 3
			.Object.Picture = LoadPicture("C:dataimage" & i & ".jpg")
			.Object.BorderStyle = 0
			.Object.BackStyle = 0
	 End With
	Next i
End Sub

The variable is declared as an OLEObject, and then the SET keyword is used to assign an image to the object.  The object is then populated with an image and inserted into the Excel sheet – some formatting taking place at the same time. I have then added a loop to the code to insert 100 images into the Excel sheet.  Occasionally this causes an automation error, but sometimes it doesn’t – frustrating, right?

The error often occurs when Excel runs out of memory – assigning an object over and over again without clearing the object could mean that Excel is struggling with memory and could lead to an automation error.

We can solve this problem 2 ways:

1. Set the object to NOTHING after it is inserted each time
2. Add an error trap to the code.

Sub InsertPicture()
On Error Resume Next
	Dim i As Integer
	For i = 1 To 100
		With Worksheets("Sheet1")
 		Set shp = .OLEObjects.Add(ClassType:="Forms.Image.1", _
 		Link:=False, DisplayAsIcon:=False, Left:=.Cells(i, "A").Left
		, Top:=.Cells(i, "A").Top, Width:=264, Height:=124)
 		End With
		 With shp
			.Object.PictureSizeMode = 3
			.Object.Picture = LoadPicture("C:dataimage" & i & ".jpg")
			.Object.BorderStyle = 0
			.Object.BackStyle = 0
	 End With
	Set shp = Nothing
	Next i
End Sub

Make sure your PC is up to date

A third way to solve the problem is to install the required update to Office or Windows, or the latest version of the .Net framework.  You can check to see if there are any updates available for your PC in your ‘Check for updates’ setting on your PC.

In Windows 10, you can type ‘updates’ in the search bar, and it will enable you to click on “Check for updates“.

It is always a good idea to keep your machine up to date.

Run a Registry Check

If all else fails, there are external software programs that you can download to run a check on the registry of your PC.

As you can see from above, this error often has a mind of its own – and can be very frustrating to solve.  A lot of the times trial and error is required, however, writing clean code with good error traps and referring to methods, properties and objects correctly often can solve the problem.

“Abort, Retry, Fail?” – MS-DOS error message circa 1986

This post provides a complete guide to VBA Error Handing. If you are looking for a quick summary then check out the quick guide table in the first section.

If you are looking for a particular topic on VBA Error Handing then check out the table of contents below(if it’s not visible click on the post header).

If you are new to VBA Error Handling, then you can read the post from start to finish as it is laid out in logical order.

A Quick Guide to Error Handing

The Webinar

Members of the Webinar Archives can access the webinar for this article by clicking on the image below.

(Note: Archive members have access to the webinar archive.)

Download the Error Handling Library

Introduction

Error Handling refers to code that is written to handle errors which occur when your application is running. These errors are normally caused by something outside your control like a missing file, database being unavailable, data being invalid etc.

If we think an error is likely to occur at some point, it is good practice to write specific code to handle the error if it occurs and deal with it.

For all other errors, we use generic code to deal with them. This is where the VBA error handling statement comes into play. They allow our application to deal gracefully with any errors we weren’t expecting.

To understand error handling we must first understand the different types of errors in VBA.

VBA Errors

There are three types of errors in VBA:

1. Syntax
2. Compilation
3. Runtime

We use error handling to deal with runtime errors. Let’s have a look at each of these error types so that it is clear what a runtime error is.

Syntax Errors

If you have used VBA for any length of time you will have seen a syntax error. When you type a line and press return, VBA will evaluate the syntax and if it is not correct it will display an error message.

For example if you type If and forget the Then keyword, VBA will display the following error message

Some examples of syntax errors are

' then is missing
If a > b

' equals is missing after i
For i 2 To 7

' missing right parenthesis
b = left("ABCD",1

Syntax errors relate to one line only. They occur when the syntax of one line is incorrect.

Note: You can turn off the Syntax error dialog by going to Tools->Options and checking off “Auto Syntax Check”. The line will still appear red if there is an error but the dialog will not appear.

Compilation Errors

Compilation errors occur over more than one line. The syntax is correct on a single line but is incorrect when all the project code is taken into account.

Examples of compilation errors are:

• If statement without corresponding End If statement
• For without Next
• Select without End Select
• Calling a Sub or Function that does not exist
• Calling a Sub or Function with the wrong parameters
• Giving a Sub or Function the same name as a module
• Variables not declared(Option Explicit must be present at the top of the module)

The following screenshot shows a compilation error that occurs when a For loop has no matching Next statement.

Using Debug->Compile

To find compilation errors, we use Debug->Compile VBA Project from the Visual Basic menu.

When you select Debug->Compile, VBA displays the first error it comes across.

When this error is fixed, you can run Compile again and VBA will then find the next error.

Debug->Compile will also include syntax errors in it’s search which is very useful.

If there are no errors left and you run Debug->Compile , it may appear that nothing happened. However, “Compile” will be grayed out in the Debug menu. This means your application has no compilation errors at the current time.

Debug->Compile Error Summary

• Debug->Compile finds compilation(project wide) errors.
• It will also find syntax errors.
• It finds one error each time you use it.
• When there are no compilation errors left the Compile option will appear grayed out in the menu.

Debug->Compile Usage

You should always use Debug->Compile before you run your code. This ensures that your code has no compilation errors when you run it.

If you do not run Debug->Compile then VBA may find compile errors when it runs. These should not be confused with Runtime errors.

Runtime Errors

Runtime errors occur when your application is running. They are normally outside of your control but can be caused by errors in your code.

For example, imagine your application reads from an external workbook. If this file gets deleted then VBA will display an error when your code tries to open it.

Other examples of runtime errors are

• a database not being available
• the user entering invalid data
• a cell containing text instead of a number

As we have seen, the purpose of error handling is to deal with runtime errors when they occur.

Expected Versus Unexpected Errors

When we think a runtime error could occur we put code in place to handle it. For example, we would normally put code in place to deal with a file not being found.

The following code checks if the file exists before it tries to open it. If the file does not exist then a user friendly message is displayed and the code exits the sub.

' https://excelmacromastery.com/
Sub OpenFile()
    
    Dim sFile As String
    sFile = "C:docsdata.xlsx"
    
    ' Use Dir to check if file exists
    If Dir(sFile) = "" Then
        ' if file does not exist display message
        MsgBox "Could not find the file " & sFile
        Exit Sub
    End If
    
    ' Code will only reach here if file exists
    Workbooks.Open sFile
    
End Sub

When we think an error is likely to occur at some point, it is good practice to add code to handle the situation. We normally refer to these errors as expected errors.

If we don’t have specific code to handle an error it is considered an unexpected error. We use the VBA error handling statements to handle the unexpected errors.

Runtime Errors that are not VBA Errors

Before we look at the VBA Handling there is one type of error we must mention. Some runtime errors are not considered errors by VBA but only by the user.

Let me explain this with an example. Imagine you have an application that requires you to add the values in the variables a and b

result = a + b

Let’s say you mistakenly use an asterisk instead of the plus sign

result = a * b

This is not a VBA error. Your code syntax is perfectly legal. However, from your requirements point of view it is an error.

These errors cannot be dealt with using error handling as they obviously won’t generate any error. You can deal with these errors using Unit Testing and Assertions. I have an in-depth post about using VBA assertions – see How to Make Your Code BulletProof.

The On Error Statement

As we have seen there are two ways to treat runtime errors

1. Expected errors – write specific code to handle them.
2. Unexpected errors – use VBA error handling statements to handle them.

The VBA On Error statement is used for error handling. This statement performs some action when an error occurs during runtime.

There are four different ways to use this statement

1. On Error GoTo 0 – the code stops at the line with the error and displays a message.
2. On Error Resume Next – the code moves to next line. No error message is displayed.
3. On Error GoTo [label] – the code moves to a specific line or label. No error message is displayed. This is the one we use for error handling.
4. On Error GoTo -1 – clears the current error.

Let’s look at each of these statements in turn.

On Error GoTo 0

This is the default behavior of VBA. In other words, if you don’t use On Error then this is the behavior you will see.

When an error occurs, VBA stops on the line with the error and displays the error message. The application requires user intervention with the code before it can continue. This could be fixing the error or restarting the application. In this scenario no error handling takes place.

Let’s look at an example. In the following code, we have not used any On Error line so VBA will use the On Error GoTo 0 behavior by default.

' https://excelmacromastery.com/
Sub UsingDefault()

    Dim x As Long, y As Long
    
    x = 6
    y = 6 / 0
    x = 7

End Sub

The second assignment line results in a divide by zero error. When we run this code we will get the error message shown in the screenshot below

When the error appears you can choose End or Debug

If you select End then the application simply stops.
If you select Debug the application stops on the error line as the screenshot below shows

This behaviour is fine when you are writing VBA code as it shows you the exact line with the error.

This behavior is unsuitable for an application that you are given to a user. These errors look unprofessional and they make the application look unstable.

An error like this is essentially the application crashing. The user cannot continue on without restarting the application. They may not use it at all until you fix the error for them.

By using On Error GoTo [label] we can give the user a more controlled error message. It also prevents the application stopping. We can get the application to perform in a predefined manner.

On Error Resume Next

Using On Error Resume Next tells VBA to ignore the error and continue on.

There are specific occasions when this is useful. Most of the time you should avoid using it.

If we add Resume Next to our example Sub then VBA will ignore the divide by zero error

' https://excelmacromastery.com/
Sub UsingResumeNext()

    On Error Resume Next
    
    Dim x As Long, y As Long
    
    x = 6
    y = 6 / 0
    x = 7

End Sub

It is not a good idea to do this. If you ignore the error, then the behavior can be unpredictable. The error can affect the application in multiple ways.You could end up with invalid data. The problem is that you aren’t aware that something went wrong because you have suppressed the error.

The code below is an example of where using Resume Next is valid

' https://excelmacromastery.com/
Sub SendMail()

   On Error Resume Next
   
    ' Requires Reference:
    ' Microsoft Outlook 15.0 Object Library
    Dim Outlook As Outlook.Application
    Set Outlook = New Outlook.Application

    If Outlook Is Nothing Then
        MsgBox "Cannot create Microsoft Outlook session." _
                   & " The email will not be sent."
        Exit Sub
    End If
    
End Sub

In this code we are checking to see if Microsoft Outlook is available on a computer. All we want to know is if it is available or not. We are not interested in the specific error.

In the code above, we continue on if there is an error. Then in the next line we check the value of the Outlook variable. If there has been an error then the value of this variable will be set to Nothing.

This is an example of when Resume could be useful. The point is that even though we use Resume we are still checking for the error. The vast majority of the time you will not need to use Resume.

On Error GoTo [label]

This is how we use Error Handling in VBA. It is the equivalent of the Try and Catch functionality you see in languages such as C# and Java.

When an error occurs you send the error to a specific label. It is normally at the bottom of the sub.

Let’s apply this to the sub we have been using

' https://excelmacromastery.com/
Sub UsingGotoLine()

    On Error GoTo eh
    
    Dim x As Long, y As Long
    
    x = 6
    y = 6 / 0
    x = 7
    
Done:
    Exit Sub
eh:
    MsgBox "The following error occurred: " & Err.Description
End Sub

The screenshot below shows what happens when an error occurs

VBA jumps to the eh label because we specified this in the On Error Goto line.

Note 1: The label we use in the On…GoTo statement, must be in the current Sub/Function. If not you will get a compilation error.

Note 2: When an error occurs when using On Error GoTo [label], the error handling returns to the default behaviour i.e. The code will stop on the line with the error and display the error message. See the next section for more information about this.

On Error GoTo -1

This statement is different than the other three. It is used to clear the current error rather than setting a particular behaviour.

When an error occurs using On Error GoTo [label], the error handling behaviour returns to the default behaviour i.e. “On Error GoTo 0”. That means that if another error occurs the code will stop on the current line.

This behaviour only applies to the current sub. Once we exit the sub, the error will be cleared automatically.

Take a look at the code below. The first error will cause the code to jump to the eh label. The second error will stop on the line with the 1034 error.

' https://excelmacromastery.com/
Sub TwoErrors()

    On Error Goto eh
        
    ' generate "Type mismatch" error
    Error (13)

Done:
    Exit Sub
eh:
    ' generate "Application-defined" error
    Error (1034)
End Sub

If we add further error handling it will not work as the error trap has not been cleared.

In the code below we have added the line

On Error Goto eh_other

after we catch the first error.

This has no effect as the error has not been cleared. In other words the code will stop on the line with the error and display the message.

' https://excelmacromastery.com/
Sub TwoErrors()

    On Error Goto eh
        
    ' generate "Type mismatch" error
    Error (13)

Done:
    Exit Sub
eh:
    On Error Goto eh_other
    ' generate "Application-defined" error
    Error (1034)
Exit Sub
eh_other:
    Debug.Print "eh_other " & Err.Description
End Sub

To clear the error we use On Error GoTo -1. Think of it like setting a mouse trap. When the trap goes off you need to set it again.

In the code below we add this line and the second error will now cause the code to jump to the eh_other label

' https://excelmacromastery.com/
Sub TwoErrors()

    On Error Goto eh
        
    ' generate "Type mismatch" error
    Error (13)

Done:
    Exit Sub
eh:
    ' clear error
    On Error Goto -1
    
    On Error Goto eh_other
    ' generate "Application-defined" error
    Error (1034)
Exit Sub
eh_other:
    Debug.Print "eh_other " & Err.Description
End Sub

Note 1: There are probably rare cases where using On Error GoTo -1 is useful. In most cases using Resume Next is better as it clears the error and resumes the code at the next line after the error occurs.

Note 2: The Err Object has a member Clear. Using Clear clears the text and numbers in the Err object, but it does NOT reset the error.

Using On Error

As we have seen, VBA will do one of three things when an error occurs

• Stop and display the error.
• Ignore the error and continue on.
• Jump to a specific line.

VBA will always be set to one of these behaviors. When you use On Error, VBA will change to the behaviour you specify and forget about any previous behavior.

In the following Sub, VBA changes the error behaviour each time we use the On Error statement

' https://excelmacromastery.com/
Sub ErrorStates()

    Dim x As Long
    
    ' Go to eh label if error
    On Error Goto eh
    
    ' this will ignore the error on the following line
    On Error Resume Next
    x = 1 / 0
    
    ' this will display an error message on the following line
    On Error Goto 0
    x = 1 / 0
  
Done:  
   Exit Sub
eh:
    Debug.Print Err.Description
End Sub

Resume Next

The Resume Next statement is used to clear the error and then resume the code from the line after where the error occurred.

If your code can have multiple errors and you want to keep detecting them then this line is very useful.

For example, in the following code we want to resume the code after the error has been reported:

Private Sub Main()

    On Error Goto eh
    
    Dim i As Long
    For i = 1 To 3
        ' Generate type mismatch error
         Error 13
    Next i

done:
    Exit Sub
eh:
    Debug.Print i, Err.Description
End Sub

 
We could use On Error Goto -1 to clear the code and then use a goto statement to go back to the code like this:

Private Sub Main()

    On Error Goto eh
    
    Dim i As Long
    For i = 1 To 3
        ' Generate type mismatch error
         Error 13
continue:
    Next i

done:
    Exit Sub
eh:
    Debug.Print i, Err.Description
    On Error Goto -1 ' clear the error
    Goto continue ' return to the code
End Sub

 
The Resume Next provides a nicer way of doing it and it always means the code is much clearer and easier to understand:

Private Sub Main()

    On Error Goto eh
    
    Dim i As Long
    For i = 1 To 3
        ' Generate type mismatch error
         Error 13
continue:
    Next i

done:
    Exit Sub
eh:
    Debug.Print i, Err.Description
    ' clear the error and return to the code
    Resume Next  
End Sub

The Err Object

When an error occurs you can view details of the error using the Err object.

When an runtime error occurs, VBA automatically fills the Err object with details.

The code below will print “Error Number: 13 Type Mismatch” which occurs when we try to place a string value in the long integer total

' https://excelmacromastery.com/
Sub UsingErr()

    On Error Goto eh
    
    Dim total As Long
    total = "aa"

Done:
    Exit Sub
eh:
    Debug.Print "Error number: " & Err.Number _
            & " " & Err.Description
End Sub

The Err.Description provides details of the error that occurs. This is the text you normally see when an error occurs e.g. “Type Mismatch”

The Err.Number is the ID number of the error e.g. the error number for “Type Mismatch” is 13. The only time you really need this is if you are checking that a specific error occurred and this is only necessary on rare occasions.

The Err.Source property seems like a great idea but it does not work for a VBA error. The source will return the project name, which hardly narrows down where the error occurred. However, if you create an error using Err.Raise you can set the source yourself and this can be very useful.

Getting the Line Number

The Erl function is used to return the line number where the error occurs.

It often causes confusion. In the following code, Erl will return zero

' https://excelmacromastery.com/
Sub UsingErr()

    On Error Goto eh
    
    Dim val As Long
    val = "aa"

Done:
    Exit Sub
eh:
    Debug.Print Erl
End Sub

This is because there are no line numbers present. Most people don’t realise it but VBA allows you to have line numbers.

If we change the Sub above to have line number it will now print out 20

' https://excelmacromastery.com/
Sub UsingErr()

10        On Error Goto eh
          
          Dim val As Long
20        val = "aa"

Done:
30        Exit Sub
eh:
40        Debug.Print Erl
End Sub

Adding line numbers to your code manually is cumbersome. However there are tools available that will allow you to easily add and remove line numbers to a sub.

When you are finished working on a project and hand it over to the user it can be useful to add line numbers at this point. If you use the error handling strategy in the last section of this post, then VBA will report the line where the error occurred.

Using Err.Raise

Err.Raise allows us to create errors. We can use it to create custom errors for our application which is very useful. It is the equivalent of the Throw statement in JavaC#.

The format is as follows

Err.Raise [error number], [error source], [error description]

Let’s look at a simple example. Imagine we want to ensure that a cell has an entry that has a length of 5 characters. We could have a specific message for this

' https://excelmacromastery.com/
Public Const ERROR_INVALID_DATA As Long = vbObjectError + 513

Sub ReadWorksheet()

    On Error Goto eh
    
    If Len(Sheet1.Range("A1")) <> 5 Then
        Err.Raise ERROR_INVALID_DATA, "ReadWorksheet" _
            , "The value in the cell A1 must have exactly 5 characters."
    End If
    
    ' continue on if cell has valid data
    Dim id As String
    id = Sheet1.Range("A1")
    

Done:
    Exit Sub
eh:
    ' Err.Raise will send code to here
    MsgBox "Error found: " & Err.Description
End Sub

When we create an error using Err.Raise we need to give it a number. We can use any number from 513 to 65535 for our error. We must use vbObjectError with the number e.g.

Err.Raise vbObjectError + 513

Using Err.Clear

Err.Clear is used to clear the text and numbers from the Err.Object. In other words, it clears the description and number.If you want the clear the actual error you can use either On Error GoTo -1 or Resume Next

It is rare that you will need to use Err.Clear but let’s have a look at an example where you might.

In the code below we are counting the number of errors that will occur. To keep it simple we are generating an error for each odd number.

We check the error number each time we go through the loop. If the number does not equal zero then an error has occurred. Once we count the error we need to set the error number back to zero so it is ready to check for the next error.

' https://excelmacromastery.com/
Sub UsingErrClear()

    Dim count As Long, i As Long

    ' Continue if error as we will check the error number
    On Error Resume Next
    
    For i = 0 To 9
        ' generate error for every second one
        If i Mod 2 = 0 Then Error (13)
        
        ' Check for error
        If Err.Number <> 0 Then
            count = count + 1
            Err.Clear    ' Clear Err once it is counted
        End If
    Next

    Debug.Print "The number of errors was: " & count
End Sub

Note 1: Err.Clear resets the text and numbers in the error object but it does not clear the error – see Resume Next Or On Error GoTo -1 for more information about clearing the actual error.

Logging

Logging means writing information from your application when it is running. When an error occurs you can write the details to a text file so you have a record of the error.

The code below shows a very simple logging procedure

' https://excelmacromastery.com/
Sub Logger(sType As String, sSource As String, sDetails As String)
    
    Dim sFilename As String
    sFilename = "C:templogging.txt"
    
    ' Archive file at certain size
    If FileLen(sFilename) > 20000 Then
        FileCopy sFilename _
            , Replace(sFilename, ".txt", Format(Now, "ddmmyyyy hhmmss.txt"))
        Kill sFilename
    End If
    
    ' Open the file to write
    Dim filenumber As Variant
    filenumber = FreeFile 
    Open sFilename For Append As #filenumber
    
    Print #filenumber, CStr(Now) & "," & sType & "," & sSource _
                                & "," & sDetails & "," & Application.UserName
    
    Close #filenumber
    
End Sub

You can use it like this

' Create unique error number
' https://excelmacromastery.com/
Public Const ERROR_DATA_MISSING As Long = vbObjectError + 514

Sub CreateReport()

    On Error Goto eh
    
    If Sheet1.Range("A1") = "" Then
       Err.Raise ERROR_DATA_MISSING, "CreateReport", "Data is missing from Cell A1"
    End If

    ' other code here
Done:
    Exit Sub
eh:
    Logger "Error", Err.Source, Err.Description
End Sub

The log is not only for recording errors. You can record other information as the application runs. When an error occurs you can then check the sequence of events before an error occurred.

Below is an example of logging. How you implement logging really depends on the nature of the application and how useful it will be:

' https://excelmacromastery.com/
Sub ReadingData()
    
    Logger "Information", "ReadingData()", "Starting to read data."
       
    Dim coll As New Collection
    ' add data to the collection
    coll.Add "Apple"
    coll.Add "Pear"
    
    If coll.Count < 3 Then
        Logger "Warning", "ReadingData()", "Number of data items is low."
    End If
    Logger "Information", "ReadingData()", "Number of data items is " & coll.Count
    
    Logger "Information", "ReadingData()", "Finished reading data."

End Sub

Having a lot of information when dealing with an error can be very useful. Often the user may not give you accurate information about the error that occurred. By looking at the log you can get more accurate information about the information.

This section covers some of the other Error Handling tools that VBA has. These items are considered obsolete but I have included them as they may exist in legacy code.

Error Function

The Error Function is used to print the error description from a given error number. It is included in VBA for backward compatibility and is not needed because you can use the Err.Description instead.

Below are some examples:

' Print the text "Division by zero"
Debug.Print Error(11)
' Print the text "Type mismatch"
Debug.Print Error(13)
' Print the text "File not found"
Debug.Print Error(53)

Error Statement

The Error statement allows you to simulate an error. It is included in VBA for backward compatibility. You should use Err.Raise instead.

In the following code we simulate a “Divide by zero” error.

' https://excelmacromastery.com/
Sub SimDivError()

    On Error Goto eh
        
    ' This will create a division by zero error
    Error 11
    
    Exit Sub
eh:
    Debug.Print Err.Number, Err.Description
End Sub

This statement is included in VBA for backward compatibility. You should use Err.Raise instead.

A Simple Error Handling Strategy

With all the different options you may be confused about how to use error handling in VBA. In this section, I’m going to show you how to implement a simple error handling strategy that you can use in all your applications.

The Basic Implementation

This is a simple overview of our strategy

1. Place the On Error GoTo Label line at the start of our topmost sub.
2. Place the error handling Label at the end of our topmost sub.
3. If an expected error occurs then handle it and continue.
4. If the application cannot continue then use Err.Raise to jump to the error handling label.
5. If an unexpected error occurs the code will automatically jump to the error handling label.

The following image shows an overview of how this looks

The following code shows a simple implementation of this strategy:

' https://excelmacromastery.com/
Public Const ERROR_NO_ACCOUNTS As Long = vbObjectError + 514

Sub BuildReport()

    On Error Goto eh
    
    ' If error in ReadAccounts then jump to error
    ReadAccounts
    
    ' Do something with the code
    
Done:
    Exit Sub
eh:
    ' All errors will jump to here
    MsgBox Err.Source & ": The following error occured  " & Err.Description
End Sub

Sub ReadAccounts()
    
    ' EXPECTED ERROR - Can be handled by the code
    ' Application can handle A1 being zero
    If Sheet1.Range("A1") = 0 Then
        Sheet1.Range("A1") = 1
    End If
    
    ' EXPECTED  ERROR - cannot be handled by the code
    ' Application cannot continue if no accounts workbook
    If Dir("C:DocsAccount.xlsx") = "" Then
        Err.Raise ERROR_NO_ACCOUNTS, "UsingErr" _
                , "There are no accounts present for this month."
    End If

    ' UNEXPECTED ERROR - cannot be handled by the code
    ' If cell B3 contains text we will get a type mismatch error
    Dim total As Long
    total = Sheet1.Range("B3")
    
    
    ' continue on and read accounts
    
End Sub

This is a nice way of implementing error handling because

• We don’t need to add error handling code to every sub.
• If an error occurs then VBA exits the application gracefully.

A Complete Error Handling Strategy

The above strategy has one major drawback. It doesn’t provide any information about the error. It is better than having no strategy as it prevents the application crashing. But that is the only real benefit.

VBA doesn’t fill Err.Source with anything useful so we have to do this ourselves.

In this section, I am going to introduce a more complete error strategy. I have written two subs that perform all the heavy lifting so all you have to do is add them to your project.

The purpose of this strategy is to provide you with the Stack* and line number when an error exists.

*The Stack is the list of sub/functions that were currently in use when the error occurred.

This is our strategy

1. Place error handling in all the subs.
2. When an error occurs, the error handler adds details to the error and raises it again.
3. When the error reaches the topmost sub it is displayed.

We are simply “bubbling” the error to the top. The following diagram shows a simple visual of what happens when an error occurs in Sub3

The only messy part to this is formatting the strings correctly. I have written two subs that handle this, so it is taken care of for you.

There are the two helper subs, RaiseError and DisplayError. You can download the library below:

An Example of using this strategy

Here is a simple coding example that uses these subs. In this strategy, we don’t place any code in the topmost sub. We only call subs from it.

' https://excelmacromastery.com/
Sub Topmost()

    On Error Goto EH
    
    Level1

Done:
    Exit Sub
EH:
    DisplayError Err.source, Err.Description, "Module1.Topmost", Erl
End Sub

Sub Level1()

    On Error Goto EH
    
    Level2

Done:
    Exit Sub
EH:
   RaiseError Err.Number, Err.source, "Module1.Level1", Err.Description, Erl
End Sub

Sub Level2()

    On Error Goto EH
    
    ' Error here
    Dim a As Long
    a = "7 / 0"

Done:
    Exit Sub
EH:
    RaiseError Err.Number, Err.source, "Module1.Level2", Err.Description, Erl
End Sub

The result looks like this:

If your project has line numbers the result will include the line number of the error:

Error Handling in a Nutshell

• Error Handling is used to handle errors that occur when your application is running.
• You write specific code to handle expected errors. You use the VBA error handling statement On Error GoTo [label] to send VBA to a label when an unexpected error occurs.
• You can get details of the error from Err.Description.
• You can create your own error using Err.Raise.
• Using one On Error statement in the top most sub will catch all errors in subs that are called from here.
• If you want to record the name of the Sub with the error, you can update the error and rethrow it.
• You can use a log to record information about the application as it is running.

What’s Next?

Free VBA Tutorial If you are new to VBA or you want to sharpen your existing VBA skills then why not try out the The Ultimate VBA Tutorial.

Related Training: Get full access to the Excel VBA training webinars and all the tutorials.

(NOTE: Planning to build or manage a VBA Application? Learn how to build 10 Excel VBA applications from scratch.)

I have a worksheet named «Dates» (object name is A_Dates) that needs to be calculated when it is activated (It may be worth noting that this is in my Personal macro workbook). I regularly have workbooks open that have too many calculations in the for me to have auto-calculation on. So I have auto-calc set to manual, and the following code in the worksheet:

Private Sub Worksheet_Activate()
   A_Dates.Calculate
End Sub

This has worked fine for the last 3 months, day-in and day-out. Yesterday, it stopped working. It now throws this error on the declaration line:

Microsoft Visual Basic
Automation error
Unspecified error
[OK] [Help]

I have tried changing how I reference the sheet, using:

Sheets("Dates").Calculate

and

ActiveSheet.Calculate

to no avail. I’ve also included error handling:

On Error Resume Next

which doesn’t prevent it. I’ve even gone so far as:

Private Sub Worksheet_Activate()
   On Error GoTo headache
   Sheets("Dates").Calculate
Exit Sub

headache:
   Exit Sub
End Sub

and it still shows up. I am totally at a loss. Help?

Additional Information

I have the following references, and use all of them in various macros in this workbook:

Visual Basic for Applications

• Microsoft Excel 12.0 Object Library
• OLE Automation
• Microsoft Office 12.0 Object Library
• Microsoft Scripting Runtime
• Microsoft Forms 2.0 Object Runtime
• Microsoft HTML Object Library
• Microsoft Internet Controls
• Microsoft ActiveX Data Objects 2.8 Library
• Microsoft ActiveX Data Objects Recordset 2.8 Library

Sub SuperAutomation()

Dim Maxtours As Long
wbyr = 2019
nwbyr = 2020
Set ads = Worksheets("AdSelect")
Set atm = Worksheets("ATM")
Set am = Worksheets("AM")
Set AMPD = Worksheets("AMPD")
Set remcap = Worksheets("CAP")
Set adstemp = Worksheets("Temp")


If adstemp.Range("A6").Value = "Just Go" Then
JG = True
Omega = False
Else
Omega = True
JG = False
End If


Maxtours = adstemp.Range("A5").Value


adstemp.Activate
PaperName = Range("A2").Value
templatesize = Range("A3").Value
WCD = ads.Range("A1").Value
lastrowADST = Cells(Rows.Count, "A").End(xlUp).Row


'Open Automation Hub


Application.ScreenUpdating = False


ahopen = False


If ahopen <> True Then
Application.DisplayAlerts = False
Set ah = Workbooks.Open("H:SalesRegional Press Selections" & wbyr & "Automation Hub.xlsx", False, False)
Application.DisplayAlerts = True
Else
ah.Activate
End If


Set Sp = Worksheets("Start Page")
Set tw1 = Worksheets("Tour Weighting 1")
Set tw2 = Worksheets("Tour Weighting 2")
Set ar = Worksheets("Ad Recency")
Set roi = Worksheets("ROI")
Set cap = Worksheets("Capacity")
Set lt = Worksheets("Lead Time")
Set fr = Worksheets("Frequency")
Set dv = Worksheets("Discount Value")
Set dl = Worksheets("Discount Lead")
Set *** = Worksheets("Assorted")


On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Temp").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add.Name = "Temp"
Set temp = Worksheets("Temp")
Application.ScreenUpdating = False


'Populate Start Page


Sp.Activate
Cells.EntireColumn.Hidden = False
Cells.EntireRow.Hidden = False
On Error Resume Next
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
On Error GoTo 0


Application.ScreenUpdating = False
Range("3:3", Range("3:3").End(xlDown)).Delete xlUp
Range("3:3", Range("3:3").End(xlDown)).Delete xlUp
Range("A3").Activate


adstemp.Range("A12:A" & lastrowADST).Copy Sp.Range("E3")
adstemp.Range("B12:B" & lastrowADST).Copy Sp.Range("F3")
adstemp.Range("C12:C" & lastrowADST).Copy Sp.Range("H3")
adstemp.Range("D12:D" & lastrowADST).Copy Sp.Range("K3")
Lastrow = Cells(Rows.Count, "E").End(xlUp).Row


Range("A3:A" & Lastrow).Value = PaperName
Range("B3:B" & Lastrow).Value = WCD
Range("C3:C" & Lastrow).Value = templatesize
Range("C:C").NumberFormat = "m/d/yyyy"
Range("H:H").NumberFormat = "m/d/yyyy"


Range("I3:I" & Lastrow).FormulaR1C1 = "=LEFT(RC5,1)"


Range("F3:K" & Lastrow).Copy
Range("F3").PasteSpecial xlPasteValues
Range("A3").Select


Range("H:H").NumberFormat = "dd/mm/yyyy"
Range("K:L").NumberFormat = "£#,##0.00"
Application.ScreenUpdating = False


' Remove blank lines


Range("A3").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "H").Value = "" Then
        ActiveCell.EntireRow.Delete
        ActiveCell.Offset(-1, 0).Activate
    End If
    ActiveCell.Offset(1, 0).Activate
Loop


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set a = Workbooks.Open("H:SalesRegional Press Selections" & wbyr & "Advert Data " & wbyr & ".csv", False, True)
Application.DisplayAlerts = True
Application.ScreenUpdating = False


Sp.Activate


Range("M3:M" & Lastrow).FormulaR1C1 = "=IFERROR(INDEX('[" & ads.Parent.Name & "]AMPD'!C3,MATCH(RC1,'[" & ads.Parent.Name & "]AMPD'!C5,0),FALSE),"""")"


Range("M3:M" & Lastrow).Copy
Range("M3").PasteSpecial xlPasteValues


a.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Y2:Y" & Lastrow).FormulaR1C1 = "=COUNTIFS('[Automation Hub.xlsx]Start Page'!C5,RC1)"
Range("X2:X" & Lastrow).FormulaR1C1 = "=IFERROR(INDEX('[" & ads.Parent.Name & "]AMPD'!C3,MATCH(RC14,'[" & ads.Parent.Name & "]AMPD'!C5,0),FALSE),"""")"
Range("L:L").NumberFormat = "dd/mm/yyyy"
Range("X2:Y" & Lastrow).Copy
Range("X2").PasteSpecial xlPasteValues


Sp.Activate
Lastrow = Cells(Rows.Count, "E").End(xlUp).Row


Range("O3:O" & Lastrow).FormulaR1C1 = "=COUNTIFS('" & a.Name & "'!C1,RC5,'" & a.Name & "'!C14,RC1)"
Range("P3:P" & Lastrow).FormulaR1C1 = "=COUNTIFS('" & a.Name & "'!C24,RC13,'" & a.Name & "'!C1,RC5,'" & a.Name & "'!C12,RC2)"
Range("R3:R" & Lastrow).FormulaR1C1 = "=COUNTIFS('" & a.Name & "'!C1,RC5,'" & a.Name & "'!C12,RC2)"
Range("O3:R" & Lastrow).Copy
Range("O3").PasteSpecial xlPasteValues


ThisYear:


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wr = Workbooks.Open("H:SalesReportingNew Weekly ReportTemplates" & wbyr & " Weekly Report Master.xlsm", False, True)
Application.DisplayAlerts = True
On Error GoTo 0
Sp.Activate
Range("G3:G" & Lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(VLOOKUP(RC5,'[" & wbyr & " Weekly Report Master.xlsm]TM Data'!C1:C8,8,FALSE),'[" & wbyr & " Weekly Report Master.xlsm]Categories & Products'!C6:C9,4,FALSE),"""")"
Application.ScreenUpdating = False


AllGood:


Range("G3:G" & Lastrow).Copy
Range("G3").PasteSpecial xlPasteValues


Application.ScreenUpdating = False
Application.DisplayAlerts = False
wr.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = False


'Sister paper = future dev


Range("A3").Activate


Range("Q3:Q" & Lastrow).Value = 0
Range("AJ3:AJ" & Lastrow).Value = 0


Sp.Activate
Range("J3:J" & Lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-5],'[" & ads.Parent.Name & "]CAP'!C1:C5,5,0),0)"
Range("J3:J" & Lastrow).Copy
Range("J3").PasteSpecial xlPasteValues




Range("A3").Activate


' Remaining Capacity Points


Do Until Cells(ActiveCell.Row, "A").Value = ""
rcap = Cells(ActiveCell.Row, "J").Value
cap.Activate
pnt = 0
Range("A3").Activate
    Do Until Cells(ActiveCell.Row, "A").Value = ""
        If Cells(ActiveCell.Row, "A").Value <= CInt(rcap) And Cells(ActiveCell.Offset(1, 0).Row, "A").Value >= CInt(rcap) Then
        pnt = Cells(ActiveCell.Row, "B").Value
        Exit Do
        End If
    ActiveCell.Offset(1, 0).Activate
    Loop
Sp.Activate
Cells(ActiveCell.Row, "AF").Value = pnt
ActiveCell.Offset(1, 0).Activate
Loop


'Template restrictions - temporary logic


Sp.Activate
Range("A3").Activate


    If InStr(Cells(ActiveCell.Row, "C").Value, "EU") > 0 Then
    Range("D3:D" & Lastrow).Value = "3,5,6,9,Z"
    Else
    Range("D3:D" & Lastrow).Value = "1,2,4,7,8,E,F,L"
    End If


'Add other points which can be determined at this stage


'Manual Weighting
Range("Y3:Y" & Lastrow).FormulaR1C1 = "=SUMIFS('Tour Weighting 1'!C3,'Tour Weighting 1'!C1,RC5)+SUMIFS('Tour Weighting 2'!C2,'Tour Weighting 2'!C1,RC6)"
'PAper Frequency
Range("AG3:AG" & Lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(IF(RC15>10,10,RC15),Frequency!C1:C2,2,FALSE),0)"
' Week Frequency
Range("AI3:AI" & Lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(IF(RC18>10,10,RC18),Frequency!C1:C2,2,FALSE),0)"
Range("Y3:AI" & Lastrow).Copy
Range("Y3").PasteSpecial xlPasteValues


***.Activate
nyt = Range("B5").Value
nyf = Range("C5").Value
tbt = Range("B7").Value
tbf = Range("C7").Value
det = Range("B10").Value
def = Range("C10").Value
Sp.Activate
Range("AH3").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Year(Cells(ActiveCell.Row, "H").Value) = wbyr Then
    Cells(ActiveCell.Row, "AK").Value = nyf
    Else
    Cells(ActiveCell.Row, "AK").Value = nyt
    End If
    If Cells(ActiveCell.Row, "D").Value <> "N/A" And Not InStr(Cells(ActiveCell.Row, "D").Value, CStr(Cells(ActiveCell.Row, "I").Value)) > 0 Then
    Cells(ActiveCell.Row, "AD").Value = tbt
    Else
    Cells(ActiveCell.Row, "AD").Value = tbf
    End If
    If Cells(ActiveCell.Row, "P").Value > 0 Then
    Cells(ActiveCell.Row, "AH").Value = det
    Else
    Cells(ActiveCell.Row, "AH").Value = def
    End If
ActiveCell.Offset(1, 0).Activate
Loop


'Last used


temp.Activate
Range("A1").Value = "Tourno"
Range("B1").Value = "Last Used"
Range("A2").Activate
a.Activate
Range("A2").Activate
run2 = False


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "Y").Value > 0 Then
    ctno = Cells(ActiveCell.Row, "A").Value
    luse = 0
        Do Until Cells(ActiveCell.Row, "A").Value <> ctno
            If Cells(ActiveCell.Row, "N").Value = PaperName And Cells(ActiveCell.Row, "L").Value > luse Then
            luse = Cells(ActiveCell.Row, "L").Value
            End If
        ActiveCell.Offset(1, 0).Activate
        Loop
    temp.Activate
    Cells(ActiveCell.Row, "A").Value = ctno
        If luse = 0 Then
        Cells(ActiveCell.Row, "B").Value = "N/A"
        Else
        Cells(ActiveCell.Row, "B").Value = luse
        End If
    ActiveCell.Offset(1, 0).Activate
    a.Activate
    End If
ActiveCell.Offset(1, 0).Activate
Loop


temp.Activate
Range("A2").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "B").Value = "N/A" Then
    ActiveCell.EntireRow.Delete xlUp
    Else
    ActiveCell.Offset(1, 0).Activate
    End If
Loop


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
If Lastrow > 2 Then
temp.Sort.SortFields.Clear
temp.Sort.SortFields.Add Key:=Range("B2:B" & Lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With temp.Sort
    .SetRange Range("A2:B" & Lastrow)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End If


Sp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("N3:N" & Lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC5,Temp!C1:C2,2,FALSE),""N/A"")"
Range("N3:N" & Lastrow).Copy
Range("N3").PasteSpecial xlPasteValues
Range("A3").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "N").Value = "N/A" Then
    wks = 999
    Else
    wks = Round((Cells(ActiveCell.Row, "B").Value - Cells(ActiveCell.Row, "N").Value) / 7, 0)
    End If
ar.Activate
Range("A3").Activate
    Do Until Cells(ActiveCell.Row, "A").Value = ""
        If Cells(ActiveCell.Row, "A").Value = wks Or Cells(ActiveCell.Offset(1, 0).Row, "A").Value = "" Then
        pnt = Cells(ActiveCell.Row, "B").Value
        Exit Do
        End If
    ActiveCell.Offset(1, 0).Activate
    Loop
Sp.Activate
Cells(ActiveCell.Row, "AB").Value = pnt
ActiveCell.Offset(1, 0).Activate
Loop


Sp.Activate
Range("N:N").NumberFormat = "dd/mm/yyyy"


Application.ScreenUpdating = False
Application.DisplayAlerts = False
a.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = False


temp.Activate
Cells.ClearContents


'sp.Activate
Range("A3").Activate
'Add discounted price when blank


Do Until Cells(ActiveCell.Row, "A").Value = ""
lt = Round((Cells(ActiveCell.Row, "H").Value - Cells(ActiveCell.Row, "B").Value) / 7, 0)
    If Cells(ActiveCell.Row, "L").Value = "" Then
    fp = Cells(ActiveCell.Row, "K").Value
    dval = 0
        Select Case Cells(ActiveCell.Row, "I").Value
        Case "5", "7", "8", "9"
        Case Else
        dl.Activate
        Range("A3").Activate
            Do Until (Cells(ActiveCell.Row, "A").Value <= lt And Cells(ActiveCell.Offset(1, 0).Row, "A").Value >= lt) Or Cells(ActiveCell.Row, "A").Value = ""
            ActiveCell.Offset(1, 0).Activate
            Loop
            If Cells(ActiveCell.Row, "A").Value = "" Then
                If lt > Cells(ActiveCell.Offset(-1, 0).Row, "A").Value Then
                    If Cells(ActiveCell.Offset(-1, 0).Row, "B").Value = "Y" Then
                    discapp = True
                    Else
                    discapp = False
                    End If
                Else
                discapp = False
                End If
            Else
                If Cells(ActiveCell.Row, "B").Value = "Y" Then
                discapp = True
                Else
                discapp = False
                End If
            End If
            If discapp = True Then
            dv.Activate
            Range("A3").Activate
                Do Until Cells(ActiveCell.Row, "A").Value = ""
                    If Cells(ActiveCell.Row, "A").Value <= fp And Cells(ActiveCell.Offset(1, 0).Row, "A").Value >= fp Then
                    dval = Cells(ActiveCell.Row, "B").Value
                    Exit Do
                    End If
                ActiveCell.Offset(1, 0).Activate
                Loop
            Else
            dval = 0
            End If
        Sp.Activate
        End Select
    Cells(ActiveCell.Row, "L").Value = Cells(ActiveCell.Row, "K").Value - dval
    End If
ActiveCell.Offset(1, 0).Activate
Loop


Sp.Activate
Range("A3").Activate


'Open Regional Press Report - to change to wbyr in Feb


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set rpr = Workbooks.Open("H:SalesReportingRegional Press ReportingRegional Press Reporting " & wbyr & ".xlsm", False, True)
Application.DisplayAlerts = True
Application.ScreenUpdating = False


Set ps = Worksheets("Price Summary")
Set lts = Worksheets("Lead Time Summary")
Set tns = Worksheets("Tour Name Summary")
Set ds = Worksheets("Destination Summary")


***.Activate
nubt = Range("B9").Value
nubf = Range("C9").Value


Sp.Activate
Range("A3").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
pname = Cells(ActiveCell.Row, "F").Value
sname = Cells(ActiveCell.Row, "G").Value
dp = Cells(ActiveCell.Row, "L").Value
lt = Round((Cells(ActiveCell.Row, "H").Value - Cells(ActiveCell.Row, "B").Value) / 7, 0)
roi1 = 0
roi2 = 0
'roi3 = 0
use1 = 0
tns.Activate
Range("A5").Activate
    Do Until Cells(ActiveCell.Row, "A").Value = ""
        If Cells(ActiveCell.Row, "A").Value = pname Then
            Select Case rop
            Case True
                Select Case JG
                Case True
                    If Cells(ActiveCell.Row, "I").Value = "" Then
                    roi1 = 0
                    Else
                    roi1 = Cells(ActiveCell.Row, "I").Value
                    End If
                use1 = Cells(ActiveCell.Row, "B").Value
                Case Else
                    If Cells(ActiveCell.Row, "Y").Value = "" Then
                    roi1 = 0
                    Else
                    roi1 = Cells(ActiveCell.Row, "YI").Value
                    End If
                use1 = Cells(ActiveCell.Row, "R").Value
                End Select
            Case Else
                Select Case JG
                Case True
                    If Cells(ActiveCell.Row, "Q").Value = "" Then
                    roi1 = 0
                    Else
                    roi1 = Cells(ActiveCell.Row, "Q").Value
                    End If
                use1 = Cells(ActiveCell.Row, "J").Value
                Case Else
                    If Cells(ActiveCell.Row, "AG").Value = "" Then
                    roi1 = 0
                    Else
                    roi1 = Cells(ActiveCell.Row, "AG").Value
                    End If
                use1 = Cells(ActiveCell.Row, "Z").Value
                End Select
            End Select
        Exit Do
        End If
    ActiveCell.Offset(1, 0).Activate
    Loop
    If roi1 = 0 And use1 = 0 Then
    ds.Activate
    Range("A4").Activate
        Do Until Cells(ActiveCell.Row, "A").Value = ""
            If Cells(ActiveCell.Row, "A").Value = sname Then
                Select Case rop
                Case True
                    Select Case JG
                    Case True
                        If Cells(ActiveCell.Row, "I").Value = "" Then
                        roi1 = 0
                        Else
                        roi1 = Cells(ActiveCell.Row, "I").Value
                        End If
                    use1 = Cells(ActiveCell.Row, "B").Value
                    Case Else
                        If Cells(ActiveCell.Row, "Y").Value = "" Then
                        roi1 = 0
                        Else
                        roi1 = Cells(ActiveCell.Row, "YI").Value
                        End If
                    use1 = Cells(ActiveCell.Row, "R").Value
                    End Select
                Case Else
                    Select Case JG
                    Case True
                        If Cells(ActiveCell.Row, "Q").Value = "" Then
                        roi1 = 0
                        Else
                        roi1 = Cells(ActiveCell.Row, "Q").Value
                        End If
                    use1 = Cells(ActiveCell.Row, "J").Value
                    Case Else
                        If Cells(ActiveCell.Row, "AG").Value = "" Then
                        roi1 = 0
                        Else
                        roi1 = Cells(ActiveCell.Row, "AG").Value
                        End If
                    use1 = Cells(ActiveCell.Row, "Z").Value
                    End Select
                End Select
            End If
        ActiveCell.Offset(1, 0).Activate
        Loop
    End If
'Below: making the assumption the price brackets in the RPR will not change!
ps.Activate
Range("A5").Activate
    If dp < 100 Then
    Range("A5").Activate
    GoTo FoundROI
    End If
    If dp > 999 Then
    Range("A25").Activate
    GoTo FoundROI
    End If
On Error GoTo NextRow
    For x = 5 To 24
        If CInt(Mid(Cells(ActiveCell.Row, "A").Value, 2, 3)) <= dp And CInt(Mid(Cells(ActiveCell.Offset(1, 0).Row, "A").Value, 2, 3)) >= dp Then
FoundROI:
            Select Case rop
            Case True
                Select Case JG
                Case True
                    If Cells(ActiveCell.Row, "I").Value = "" Then
                    roi2 = 0
                    Else
                    roi2 = Cells(ActiveCell.Row, "I").Value
                    End If
                Case Else
                    If Cells(ActiveCell.Row, "Y").Value = "" Then
                    roi2 = 0
                    Else
                    roi2 = Cells(ActiveCell.Row, "Y").Value
                    End If
                End Select
            Case Else
                Select Case JG
                Case True
                    If Cells(ActiveCell.Row, "Q").Value = "" Then
                    roi2 = 0
                    Else
                    roi2 = Cells(ActiveCell.Row, "Q").Value
                    End If
                Case Else
                    If Cells(ActiveCell.Row, "AG").Value = "" Then
                    roi2 = 0
                    Else
                    roi2 = Cells(ActiveCell.Row, "AG").Value
                    End If
                End Select
            End Select
        Exit For
        End If
NextRow:
    ActiveCell.Offset(1, 0).Activate
    Next x
On Error GoTo 0
roi.Activate
roiw1 = 0
roiw2 = 0
' roiw3 = 0  !@!
    For x = 1 To 2   'was 1 to 3
    Range("A3").Activate
        Do Until Cells(ActiveCell.Row, "A").Value = ""
            Select Case x
            Case 1
                If Cells(ActiveCell.Row, "A").Value <= roi1 And Cells(ActiveCell.Offset(1, 0).Row, "A").Value >= roi1 Then
                roiw1 = Cells(ActiveCell.Row, "B").Value
                Exit Do
                End If
            Case 2
                If Cells(ActiveCell.Row, "A").Value <= roi2 And Cells(ActiveCell.Offset(1, 0).Row, "A").Value >= roi2 Then
                roiw2 = Cells(ActiveCell.Row, "B").Value
                Exit Do
                End If
'            Case 3
'                If Cells(ActiveCell.Row, "A").Value <= roi3 And Cells(ActiveCell.Offset(1, 0).Row, "A").Value >= roi3 Then
'                roiw3 = Cells(ActiveCell.Row, "B").Value
'                Exit Do
'                End If
            End Select
        ActiveCell.Offset(1, 0).Activate
        Loop
    Next x
Sp.Activate
Cells(ActiveCell.Row, "S").Value = roi1
Cells(ActiveCell.Row, "T").Value = roi2
'Cells(ActiveCell.Row, "U").Value = roi3
Cells(ActiveCell.Row, "X").Value = roiw1
Cells(ActiveCell.Row, "AC").Value = roiw2
'Cells(ActiveCell.Row, "AE").Value = roiw3  !@!


' New Lead Time Calculation


If Cells(ActiveCell.Row, "I").Value = "3" Or Cells(ActiveCell.Row, "I").Value = "6" Then
    Cells(ActiveCell.Row, "U").FormulaR1C1 = "=ROUNDUP((RC[-13]-RC[-19])/7,0)"
    Cells(ActiveCell.Row, "U").Value = Cells(ActiveCell.Row, "U").Value
    Cells(ActiveCell.Row, "AE").FormulaR1C1 = "=VLOOKUP(ROUNDUP((RC[-23]-RC[-29])/7,0),'Lead Time'!C[-27]:C[-26],2,0)"
    Cells(ActiveCell.Row, "AE").Value = Cells(ActiveCell.Row, "AE").Value
    Else
    Cells(ActiveCell.Row, "U").FormulaR1C1 = "=ROUNDUP((RC[-13]-RC[-19])/7,0)"
    Cells(ActiveCell.Row, "U").Value = Cells(ActiveCell.Row, "U").Value
    Cells(ActiveCell.Row, "AE").FormulaR1C1 = "=VLOOKUP(ROUNDUP((RC[-23]-RC[-29])/7,0),'Lead Time'!C[-30]:C[-29],2,0)"
    Cells(ActiveCell.Row, "AE").Value = Cells(ActiveCell.Row, "AE").Value
End If
   
   If use1 = 0 And Cells(ActiveCell.Row, "R").Value < 5 Then
    Cells(ActiveCell.Row, "AM").Value = nubt
    Else
    Cells(ActiveCell.Row, "AM").Value = nubf
    End If
ActiveCell.Offset(1, 0).Activate
Loop


Application.ScreenUpdating = False
Application.DisplayAlerts = False
rpr.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = False


'First summary and ranking


Sp.Activate
Range("V3:V" & Lastrow).FormulaR1C1 = "=SUM(RC24:RC39)"
Range("W3:W" & Lastrow).FormulaR1C1 = "=RANK(RC22,C22)"
Range("V3:W" & Lastrow).Copy
Range("V3").PasteSpecial xlPasteValues


'Diversity check, and second (and third etc.) ranking


***.Activate
div1t = Range("B3").Value
div1f = Range("C3").Value
div2t = Range("B4").Value
div2f = Range("C4").Value
pt = Range("B8").Value
pf = Range("C8").Value


'Sort by ranking


Sp.Activate
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Sp.Sort.SortFields.Clear
    Sp.Sort.SortFields.Add Key:=Range("W3:W" & Lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With Sp.Sort
        .SetRange Range("A3:AM" & Lastrow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
crow = 0


' Diversity Checks and re-ranking


For x = 1 To Maxtours
Range("A3").Activate
    Do Until (Cells(ActiveCell.Row, "W").Value >= x And ActiveCell.Row > crow) Or Cells(ActiveCell.Row, "W").Value = x Or Cells(ActiveCell.Row, "A").Value = ""
    ActiveCell.Offset(1, 0).Activate
    Loop
    If Cells(ActiveCell.Row, "A").Value <> "" Then
    crow = ActiveCell.Row
    tname = Cells(ActiveCell.Row, "F").Value
    sname = Cells(ActiveCell.Row, "G").Value
    tdig = Cells(ActiveCell.Row, "I").Value
    dcod = Mid(Cells(ActiveCell.Row, "E").Value, 2, 2)
    dp = Cells(ActiveCell.Row, "K").Value
    Cells(ActiveCell.Row, "Z").Value = 100
    Cells(ActiveCell.Row, "AA").Value = 100
    Cells(ActiveCell.Row, "AL").Value = pt
    ActiveCell.Offset(1, 0).Activate
'Range("A3").Activate
        Do Until Cells(ActiveCell.Row, "A").Value = ""
            If Cells(ActiveCell.Row, "Z").Value = 0 And Cells(ActiveCell.Row, "AA").Value = 0 Then
                If (ActiveCell.Row <> crow Or (ActiveCell.Row < crow And Cells(ActiveCell.Row, "W").Value >= x)) Then
                    If Cells(ActiveCell.Row, "F").Value = tname Or Cells(ActiveCell.Row, "G").Value = sname Then
                    Cells(ActiveCell.Row, "Z").Value = div1t
                    Else
                    Cells(ActiveCell.Row, "Z").Value = div1f
                    End If
                    If Mid(Cells(ActiveCell.Row, "E").Value, 2, 2) = dcod And Left(Cells(ActiveCell.Row, "E").Value, 1) <> "E" Then
                    Cells(ActiveCell.Row, "AA").Value = div2t
                    Else
                    Cells(ActiveCell.Row, "AA").Value = div2f
                    End If
                    If Cells(ActiveCell.Row, "K").Value >= (dp * 0.66) And Cells(ActiveCell.Row, "K").Value <= (dp * 1.33) Then
                    Cells(ActiveCell.Row, "AL").Value = pt
                    Else
                    Cells(ActiveCell.Row, "AL").Value = pf
                    End If
                Else
                Cells(ActiveCell.Row, "Z").Value = div1f
                Cells(ActiveCell.Row, "AA").Value = div2f
                Cells(ActiveCell.Row, "AL").Value = pt
                End If
            End If
        ActiveCell.Offset(1, 0).Activate
        Loop
    Range("V3:V" & Lastrow).FormulaR1C1 = "=SUM(RC24:RC39)"
    Range("W3:W" & Lastrow).FormulaR1C1 = "=RANK(RC22,C22)"
    Range("V3:W" & Lastrow).Copy
    Range("V3").PasteSpecial xlPasteValues
    Sp.Sort.SortFields.Clear
    Sp.Sort.SortFields.Add Key:=Range("W3:W" & Lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With Sp.Sort
        .SetRange Range("A3:AM" & Lastrow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If
Next x


Range("A3").Activate


On Error GoTo NoSave


Sp.Copy
Range("1:1").Delete xlUp




If rop = True Then
newdir = "H:SalesRegional Press Selections" & wbyr & "Automation FilesROPwc " & Format(DateValue(WCD), "yyyy-mm-dd")
Else
newdir = "H:SalesRegional Press Selections" & wbyr & "Automation FilesRTwc " & Format(DateValue(WCD), "yyyy-mm-dd")
End If


If Dir(newdir, vbDirectory) = vbNullString Then
On Error Resume Next
MkDir newdir
On Error GoTo 0
End If


'nsname = Replace(PaperName, "/", "") & " - " & PaperName !@!


nsname = Replace(PaperName, "/", "&")


tsize = adstemp.Range("A4").Value


Set n = ActiveWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'n.SaveAs filename:=newdir & "" & nsname & " - Super - " & ".csv", FileFormat:=xlCSV, CreateBackup:=False
If adstemp.Range("A6").Value = "Just Go" Then
n.SaveAs filename:=newdir & "" & nsname & " - Super - " & tsize & " JG" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
Else
n.SaveAs filename:=newdir & "" & nsname & " - Super - " & tsize & " OM" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
End If
n.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = False




NoSave:
Resume Skip
Skip:
' Bring results back to adstemp
Range("E3:E" & Lastrow).Copy adstemp.Range("H12")
Range("F3:F" & Lastrow).Copy adstemp.Range("I12")
Range("K3:K" & Lastrow).Copy adstemp.Range("J12")
Range("W3:W" & Lastrow).Copy adstemp.Range("K12")
Range("V3:V" & Lastrow).Copy adstemp.Range("L12")
Range("Y3:Y" & Lastrow).Copy adstemp.Range("M12")


Application.EnableEvents = True
Application.DisplayAlerts = False


If ah.ReadOnly = False Then
ah.Close True
Else
ah.Close False
End If




Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub