VBA Sum Records Which Match Monthly Column Heading

[hobbiton73]

Hi, I wonder whether someone may be able to help me please.

With some help along the way and with some adaptation by myself, I’ve put together the following code

Please Login or Register  to view this content.

The code initially selects column B on the "All Data" sheet for unique values. The aim of this is to see whether the cell value matches a sheet name (already created), contained within the workbook. Then performs the following:

• When a match is found, the code then moves onto the first 'Select Case' statement and works through looking for the various criteria in the 'Case' sub routines i.e. Case nUseAllDIR, Case nUseAllEH, Case nUseAllIND, Case nUseAllOVH and Case nUseAllPRO.
  
  NB. For information, a(i, 1) = ws.Name is column B, (a(i, 6), "Consultancy & Innovation") = 0 is column G and (a(i, 8), "TM - DIR") > 0 is column I all on the "All Data" sheet.
  

• When these criteria are met the code then moves onto the following piece of code.
  
  

  Please Login or Register  to view this content.

  
  Where it looks to see if firstly there is a value in column M on the [B]"All Data"[/B ]sheet, and where it does it then copies the associated value in column Q on the "All Data" sheet.

• Finally when these values are copied, the code moves onto the second 'Select Case' statement and pastes the value into the relevant cell.

This code works, but it is painfully slow, to the point it takes over an hour to extract, and I admit, that despite trying for over a week, I've not been able to make this any better.

I just wondered whether someone may be able to look at this please and offers some guidance on how to amend this.

I appreciate that this is a fairly lengthy and technical post, my apologies, but I thought it better to be as accurate with the process as possible. To help I've included a file here: https://www.dropbox.com/s/dc3b3dwr4n...0Home.xls?dl=0


To launch the macro which extracts the data to the individual sheets please click the button, but as I say this process takes a long time.

I did try to attach the file to the post, but it was over the file size limit.

Many thanks and kind regards

Chris

[mehmetcik]

You should have posted a spreadsheet.

Try these:-

1. Run my Optimise subroutine to speed up your macro:-

Please Login or Register  to view this content.

2. Replace

Please Login or Register  to view this content.

with

Please Login or Register  to view this content.

3. What is the point of:-

Please Login or Register  to view this content.

Replace with:

Please Login or Register  to view this content.

4. What is the point of:-

Please Login or Register  to view this content.

Replace with:-

If a(i, 1) = ws.Name And InStr(a(i, 6), "Consultancy & Innovation") = 0 And InStr(a(i, 8), "TM - OVH") > 0 Then bColumnCIsConsultancyAndRequirements = True

[hobbiton73]

Hi @mehmetcik, thank you very much for taking the time to come back to me with this, it's greatly appreciated.

I made the amendments to my code as you kindly suggested, and it ran without error, but the problem is, is that this has made no difference to the time it takes to extract the information.

Many thanks and kind regards

Chris