Optimising my VBA to improve the efficiency of my Workbook

[Tmini]

Hi
I have set up a system that I use for work whereas I will quote up a job with all of the materials output as a list. Each workbook is a new unit that has it's own list of materials. They are all stored in a different job folder for each job. I then have another workbook with VBA code where I click a button find the job folder and then the VBA will work it's magic and open each file within that folder copy all of the materials data from each workbook into one final workbook. It has several sheets within it that will show different data sets depending on the information I need for each job. One of the data sets is a list of materials for each of the units. I have it so it copies all of the materials data from each workbook that it opens, Pastes the values and then I have it delete all of the irrelevant data with no value. The problem is when I have a large job of 500 files or so it can take 7 hours to run through every single workbook and delete all of the data with no value. Now I know my issue is running it so it iterates through it one line at a time but I am unsure how to make it so it will sort it all so all of the no value data is at the top and it deletes that straight away then it re-sorts itself back into the order that it should be. I have guessed that it will take a 7 hour job and reduce it to less than an hour if I can figure out how to optimise it.
With my first screenshot that is my initial job unit workbook as you can see it runs from line 1 all the way through to line 289 - this is where my materials list ends. I have to copy the entire list because every unit will have a different list of materials which is listed from rows 16 through to 289 and only shows when that material is needed for the job. When this is copied over to the new workbook I can have several hundred files copied over and that adds up to hundreds of thousands of rows with many blank rows which are all deleted. My initial thoughts are to try and number each row in alphanumeric order as they are always the same amount of rows and for each new work book that is copied have a formula which will add those numbers up from the previous workbook to number alphanumerically all the way through 1- however many rows it ends up being. I would ideally get it to sort through the data and organise it so all blank data rows are at the top and have it delete all of those rows and then have it do another sort from the alphanumeric data column to go from smallest to largest to put it back in order. I am just unsure how to do this. If anyone can help on this that would be great and it would save me so much time when I'm under the pump

The code that I use to sort the data and delete the non value rows is as follows

Sub delrowsifzero1()

    Application.ScreenUpdating = False

    Dim LastRow As Long

     Worksheets("Itemised Detail").Activate

     On Error Resume Next

       LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Dim x As Long

    ActiveWorkbook.Worksheets("Itemised Detail").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Itemised Detail").Sort.SortFields.Add Key:=Range("A:a" & LastRow) _

        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Itemised Detail").Sort

        .SetRange Range("A:a" & LastRow)

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    For x = LastRow To 2 Step -1

        If Cells(x, 1) = "" Or Cells(x, 1) = 0 Then

            Rows(x).EntireRow.Delete

        End If

    Next x

    Application.ScreenUpdating = True

    Application.CutCopyMode = False

  

            'Hide worksheets

    Worksheets("Overall Costs").Visible = xlSheetHidden

    Worksheets("Single Unit Pricing").Visible = xlSheetHidden

    Worksheets("Total Hours For All Units").Visible = xlSheetHidden

    Worksheets("Single Unit Hours").Visible = xlSheetHidden

      End Sub

 

[JustJohn91]

Have you tried setting the formula Calculation to manual when the macro starts and setting it to automatic again once complete?

application.Calculation=xlCalculationManual

Your Code

application.Calculation=xlCalculationAutomatic

 

[Joe4]

Have you tried setting the formula Calculation to manual when the macro starts and setting it to automatic again once complete?

application.Calculation=xlCalculationManual

Your Code

application.Calculation=xlCalculationAutomatic

More than that, since you have a loop updating data, it would also be even more helpful to disable screen updating until the end, i.e.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Your Code

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

 

[Tmini]

More than that, since you have a loop updating data, it would also be even more helpful to disable screen updating until the end, i.e.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Your Code

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Thanks for that I just did a quick test on 12 items it went from 1 minute 57 seconds down to 1 minute 40 seconds. It wasn't as big a saving I was hoping for but it's still something. I'll have to continue working through it to get it even faster

 

[Michael M]

You could get rid of the loop at the end by replacing this

 For x = LastRow To 2 Step -1
        If Cells(x, 1) = "" Or Cells(x, 1) = 0 Then
            Rows(x).EntireRow.Delete
        End If
    Next x

With

SubMM1()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Replace "", "#N/A", xlWhole, , False, , False, False
    .Replace "0", "#N/A", xlWhole, , False, , False, False
    Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  End With
End Sub

 

[Tmini]

You could get rid of the loop at the end by replacing this

 For x = LastRow To 2 Step -1
        If Cells(x, 1) = "" Or Cells(x, 1) = 0 Then
            Rows(x).EntireRow.Delete
        End If
    Next x

With

SubMM1()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Replace "", "#N/A", xlWhole, , False, , False, False
    .Replace "0", "#N/A", xlWhole, , False, , False, False
    Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  End With
End Sub

Sorry that didn't seem to work all my data wasn't sorted and it didn't save any time on the execution either. Thanks for your help though

 

[Peter_SSs]

I think that we can probably save you considerable time, but first it would be better if we could check if your existing code actually works or not. The posted code in post #1 will not sort your data. Is that the actual code you have been using or did you re-type or alter it for posting in the forum?

It has two errors (both the same error) in it. Twice in your code you have used Range("A:a" & LastRow)

That is not a valid range - but the code will not show the error because you have an On Error Resume Next near the start of your code meaning all errors will be ignored.

Perhaps you meant this range instead?

Range("A1:a" & LastRow)

Before making time-saving suggestions though, can you confirm ..

1. Does the 'Itemised Detail' sheet have a header row? (.Header = xlGuess leaves us guessing too )
2. How many columns of data are there on 'Itemised Detail'? I'm asking because you only seem to be trying to sort column A.
3. Does (or might) column A actually contain blank cells and other cells containing 0? Just checking because of this code line If Cells(x, 1) = "" Or Cells(x, 1) = 0 Then

 

[Tmini]

I think that we can probably save you considerable time, but first it would be better if we could check if your existing code actually works or not. The posted code in post #1 will not sort your data. Is that the actual code you have been using or did you re-type or alter it for posting in the forum?

It has two errors (both the same error) in it. Twice in your code you have used Range("A:a" & LastRow)

That is not a valid range - but the code will not show the error because you have an On Error Resume Next near the start of your code meaning all errors will be ignored.

Perhaps you meant this range instead?

Range("A1:a" & LastRow)

Before making time-saving suggestions though, can you confirm ..

1. Does the 'Itemised Detail' sheet have a header row? (.Header = xlGuess leaves us guessing too )
2. How many columns of data are there on 'Itemised Detail'? I'm asking because you only seem to be trying to sort column A.
3. Does (or might) column A actually contain blank cells and other cells containing 0? Just checking because of this code line If Cells(x, 1) = "" Or Cells(x, 1) = 0 Then

Hi Peter
Thanks for your reply - yep you've got me lol I definitely am not a programmer or developer so have very limited understanding on what a lot of the code actually means and am frankencoding my way through this
I understand that first error you pointed out and can't believe I didn't pick up myself - I'm referencing the entire column but then I'm also asking for it to go to the last row which would be the bottom of the entire workbook - I could still be wrong on this but I will modify it as per your suggestion
In response to your further questions
1. There is no header row
2. There are 6 columns of data. If you look at my first screenshot this shows you the workbook I am copying the data from. Under the materials heading I have a complete list of materials that only appear when that material is being used - I have them all formatted in white text so you can't see them and they will only change to black text when the material is being used. All of that is automatically copied over to the itemised detail sheet in a separate workbook and I am just sorting the data on column A.
3. Yes some cells are blank in column A

 

[Peter_SSs]

Thanks for the extra explanation. Unfortunately I am still pretty unclear.

Your code seemed to be working its way up column A from LastRow to 2 and deleting rows where column A is either "" or 0

• Looking at your first image it appears that cells A7 & A5 are empty so those rows would get deleted - yet there is other data in those rows further to the right that would also get deleted. Is that what you want?
  
  
• Also in the first image, cells A19:A38 appear to be empty but from your latest description it sounds like they may not be empty but just formatted white. Is that correct? If so, the code would not delete those rows.

BTW, in your two images, are we looking at the "Itemised Detail" worksheet?

I suspect that there will be more questions to follow.

 

[Tmini]

To give you extra context the first image is of the total amount of labour and materials required to build many different types of cabinets which are in other worksheets of that same workbook. That particular worksheet is called total quantities. Each work book is stored in a folder for each item that is required to be built.
The second image is of one of 11 worksheets in a workbook that is used to go through the folder copy all of the data from that the total quantities worksheet shown in the first image and create a final itemised list of all the pricing, materials and data required to complete an entire job.
A5 Does contain data but is formatted white and does not get deleted A7 is deleted. The data to the right of those columns is not required at this point in time but I might change that further down the track.
You are correct A19:A38 all contain data which is formatted white so we can see the relevant data easily rather than it being a big list of irrelevant data we don't need. That list actually extends all the way down to row 298 and this is the issue I face as when I copy the data from each workbook I am copying all the way down to row 298 from hundreds of workbooks and that adds up to thousands of lines in the final workbook which can take many hours to go through and delete all of the irrelevant data.
I don't know if this helps but it's like me going through manually selecting each row that I see which contains irrelevant data and deleting it which is extremely inefficient when I could just number each row in another column from 1 through to however many rows there are, sort it by all of the zero value data in the price column so the zero value data is at the top and selecting all that zero value data in one go and deleting it then reorganising it by my numbered rows column from one to however many to put it back in order which is far quicker - if that makes sense.
The images above are of 2 different workbooks. The first image is one of many workbooks containing the information I need and the second image is the final workbook that has copied all of the information I need from those many workbooks and put it all into one workbook. It is rather complex and difficult to explain and the VBA code I have is much larger than what I have shown here but this aspect of it relates to where my bottleneck is. I probably have more mistakes in my code that I'm unaware of but it seems to work for me pretty well except for the bottleneck of having to delete the rows with irrelevant data.