Improve VBA Calculation speed

Excelquestion35

Board Regular
Joined
Nov 29, 2021
Messages
53
Office Version
  1. 2016
Platform
  1. Windows
Hello,

I am looking for a way to improve the calculation speed in my workbook. Currently I have six macro buttons doing the same for all six departments (here D2S).

VBA Code:
Sub D2S_Button()
'Description: This macro will loop through a row and
'hide the column if the cell in row 1 of the column
'has the value of ....
   
Dim c As Range
Columns("A:CO").Hidden = False  'unhide all columns
 Range("F12").AutoFilter Field:=7, Criteria1:="D2S"
    For Each c In Range("H1:CO1").Cells
        If c.Value = "" Then
            c.EntireColumn.Hidden = True

        End If
    Next c
   
 

End Sub

Yet, when running the code, it takes about 30-60 seconds to show the necessary columns in the workbook. Even with 'only' 200 rows in the document.

Would it be wise to change this code into an array? If so, how am I able to do that?
If not, what would be wise to replace/change in order to decrease the processing time?

Unfortunately, I don't have any experience with arrays.

P.s. Don't know if it is important; I already removed a column with 6 Vlookups per cell by VBA code which does the calculation and pastes the outcome as values.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
See if this helps speed things up:
VBA Code:
Sub D2S_Button()
'Description: This macro will loop through a row and
'hide the column if the cell in row 1 of the column
'has the value of ....
   
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim c As Range
Columns("A:CO").Hidden = False  'unhide all columns
 Range("F12").AutoFilter Field:=7, Criteria1:="D2S"
    For Each c In Range("H1:CO1").Cells
        If c.Value = "" Then
            c.EntireColumn.Hidden = True

        End If
    Next c
   
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 

End Sub
 
Upvote 0
Maybe the below will be quicker:
VBA Code:
Sub D2S_Button()
   
    Range("A:CO").EntireColumn.Hidden = False
    Range("H1:CO1").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
    Range("F12").AutoFilter Field:=7, Criteria1:="D2S"
End Sub
 
Upvote 0
Thanks both for the swift reply!

@Joe4, unfortunately I don't see an improvement speed in the calculation (also hiding the columns does not work anymore)
@Georgiboy, your solution is much quicker, but the macro unfortunately does not hide the correct columns anymore
 
Upvote 0
Thanks both for the swift reply!

@Joe4, unfortunately I don't see an improvement speed in the calculation (also hiding the columns does not work anymore)
@Georgiboy, your solution is much quicker, but the macro unfortunately does not hide the correct columns anymore
That makes me question whether or not these columns really are blank.
(Note that I did not change any of the logic of your code. I simply suppressed calculations and screen updates until the end.

Are the values in row 1 hard-coded or the results of formulas?
Note that even a single space is not the same as blank/empty.
 
Upvote 0
It is a bit complicated, but couldn't think of a smarter way: for all departments in checks whether the column is a applicable (= if sum of all rows is at least higher than 0, indicating that at least somebody is somewhat skilled for a particular activity (= column))

Formula in column AC1:
VBA Code:
=IF(SUMIF($G$13:$G$1048576;$H1;AC$13:AC$1048576)>0;$H1;"")

1674570210497.png


Idea is to only show the columns that contain the value of the department in one of the six corresponding top rows
 
Upvote 0
Maybe this:
VBA Code:
Sub D2S_Button()
    Dim rCell As Range, uRng As Range
  
    Range("A:CO").EntireColumn.Hidden = False
    For Each rCell In Range("H1:CO1").Cells
        If rCell.Value = vbNullString Then
            If uRng Is Nothing Then
                Set uRng = rCell
            Else
                Set uRng = Union(uRng, rCell)
            End If
        End If
    Next rCell
   
    If Not uRng Is Nothing Then
        uRng.EntireColumn.Hidden = True
    End If
    Range("F12").AutoFilter Field:=7, Criteria1:="D2S"
End Sub

It will build a range of all of the columns with a formulae that equates to "", it will then hide all of those columns at once.
 
Upvote 0
This code seems much quicker but for some reason I am not able to get it to work.

It does the filtering in column F correctly.
Yet, it does not hide the columns without the department in the top row.
Am I doing something wrong?
 
Upvote 0
Hi all,

Just wanted to let you know that the macro was not the problem, it was the table decreasing the speed of the document.

Thank you for your input!
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,194
Members
453,021
Latest member
pingpong7117

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top