PDA

View Full Version : Ways to optimize VBA loop



emccracken
06-06-2018, 11:42 AM
I have a document with a lot of data and VLOOKUP functions that takes way to long to run loop code on. I am trying to hide a column if that column contains an X in row 3. The current code runs through each column checking for X and takes about 3 minutes to run completely. Ways to optimize or use another method to avoid the loop? I can't figure out the code to get it to select cells that have X and ignore cells that don't all at once. Here is the code I have now:


Sub HideColumns()

Dim maxCol As Integer
Dim c As Range


'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False


maxCol = Application.CountA(ActiveSheet.Rows("3:3")) + 10


For Each c In ActiveSheet.Range("L3:" & Split(Cells(1, maxCol).Address, "$")(1) & "2").Cells
If c.Value = "X" Then
c.EntireColumn.Hidden = True
End If
Next c




'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True

End Sub


As you can see I have optimization code commented off.

SamT
06-06-2018, 12:12 PM
This loops once per "X", not once per cell

Option Explicit

Sub t()
HideEm "X", 3
End Sub

Sub HideEm(HideWhat As String, RowNum As Long)
'Hides Columns containing HideWhat in Row(RowNum)
'See: http://www.vbaexpress.com/forum/showthread.php?62904

Dim Found As Range
Dim FirstAddress As String

Application.ScreenUpdating = False

With Rows(RowNum)
Set Found = .Find(HideWhat)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
Found.EntireColumn.Hidden = True
Set Found = .FindNext(HideWhat)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With

Application.ScreenUpdating = True
End Sub

Paul_Hossler
06-06-2018, 12:13 PM
Welcome to the forum

1. I added CODE tags around your macro - you can use the [#] icon on the toolbar and paste your macro between

2. I couldn't follow your macro, but going by the description, something like this would be faster, although if the hidden columns have formulas, they'd still be calculated even if hidden

3. There a few minor tweaks that might improve performance, but the increase in complexity didn't seem worth it

4. I assumed that the X's would be in L3 to the last row 3 column that has any data in it




Option Explicit

Sub HideColumns()

Dim maxCol As Long, iCol As Long

'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False

With ActiveSheet

maxCol = .Cells(3, .Columns.Count).End(xlToLeft).Column

For iCol = 12 To maxCol
If .Cells(3, iCol).Value = "X" Then
.Columns(iCol).Hidden = True
End If
Next iCol
End With

'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True

End Sub

emccracken
06-06-2018, 02:55 PM
I'm looking to do the same thing but avoid the loop. Your code works fine, it just took 3 minutes to finish.

Paul_Hossler
06-06-2018, 05:18 PM
That's strange -- post a workbook with a small but realistic example of the data

Hiding even a large number of columns really should not take that much time

emccracken
06-06-2018, 09:02 PM
Here is a sample file of what I'm trying to accomplish. 22373

Just to be clear, I don't think I can use any sort of loop. I need it to grab ALL of the columns containing an "X" in row 1 and hide the entire column.

SamT
06-07-2018, 06:59 AM
Your code works fine, Who are you talking to?


I don't think I can use any sort of loop. AFAIK, a loop is the only thing that will wotrk

Paul_Hossler
06-07-2018, 07:23 AM
Just to be clear, I don't think I can use any sort of loop. I need it to grab ALL of the columns containing an "X" in row 1 and hide the entire column.

1. I think you DO need a loop

2. That's what my little macro in post #3 does -- hide any column with an "X" in row 3 (from your post #1) -- this version of your requirements (post #6) uses row 1, so I changed my macro

3.My test data has about 300K cells in one worksheet, all cells with formulas, including a VLookup, and runs under a second (deleted lots of rows to fit the upload)

My second has 1200 columns and still runs under a second (I don't think the number of rows has any effect, other than possible formula calculations)

4. If you real data has a 800 column by 400 row square that is filled with VLOOKUP formulas, not to mention the 90+ tabs in the spreadsheet (approx. 30M cells) AND you want to run this on every sheet (you didn't tell us that), then you might change your approach.

I really think that there is something else going on in your workbook. Do you use workbook or worksheet events?







Option Explicit

Sub HideColumns()
Dim maxCol As Long, iCol As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

With ActiveSheet

maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = 1 To maxCol
If .Cells(1, iCol).Value = "X" Then .Columns(iCol).Hidden = True
Next iCol
End With

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Sub UnHideColumns()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

ActiveSheet.Columns.Hidden = False
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub




5. I'd suggest building the row 1 logic for your formula


=IF(OR(D2>TODAY()+4,D2<TODAY()-13),"X","")

into the macro and not use the "X" flag -- just seems cleaner to me

emccracken
06-07-2018, 08:22 AM
Who are you talking to?

Both codes actually work. I have three options for code now, but they all take 3 mins to run.

Paul_Hossler
06-07-2018, 08:42 AM
Well, I can't reproduce such a slow running macro using the very small and very simple sample workbook you posted

Maybe you better post a more realistic version of your workbook, with the formulas and VLookup data, etc.

Maybe delete a bunch of rows and if the worksheets are basically the same, delete any duplicates

emccracken
06-07-2018, 10:27 AM
1. I think you DO need a loop

2. That's what my little macro in post #3 does -- hide any column with an "X" in row 3 (from your post #1) -- this version of your requirements (post #6) uses row 1, so I changed my macro

3.My test data has about 300K cells in one worksheet, all cells with formulas, including a VLookup, and runs under a second (deleted lots of rows to fit the upload)

My second has 1200 columns and still runs under a second (I don't think the number of rows has any effect, other than possible formula calculations)

4. If you real data has a 800 column by 400 row square that is filled with VLOOKUP formulas, not to mention the 90+ tabs in the spreadsheet (approx. 30M cells) AND you want to run this on every sheet (you didn't tell us that), then you might change your approach.

I really think that there is something else going on in your workbook. Do you use workbook or worksheet events?







Option Explicit

Sub HideColumns()
Dim maxCol As Long, iCol As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

With ActiveSheet

maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = 1 To maxCol
If .Cells(1, iCol).Value = "X" Then .Columns(iCol).Hidden = True
Next iCol
End With

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Sub UnHideColumns()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

ActiveSheet.Columns.Hidden = False
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub




5. I'd suggest building the row 1 logic for your formula


=IF(OR(D2>TODAY()+4,D2<TODAY()-13),"X","")

into the macro and not use the "X" flag -- just seems cleaner to me


1. That puts me in a dilemma then. I need the code to run faster. Is it possible that I am running a version of Excel that is too slow for the code?

3. The number of rows may not be an issue, but I have over 100 tabs that the VLOOKUP is linked to.

4. Sorry for the confusion. I didn't tell you that I want the Macro run on every worksheet because I don't. I only want it run on the first worksheet. If I do the process manually, it takes about 1 minute, only because I have to scroll through 800 lines of data in order to highlight and hide all the cells. Because I highlight and hide all in one command manually, it goes in a second. However, in VBA, it's taking way too long to run the code that I want to run. Is it possible I am operating on a 32bit version of Excel and I need 64 or something?

emccracken
06-07-2018, 10:29 AM
Well, I can't reproduce such a slow running macro using the very small and very simple sample workbook you posted

Maybe you better post a more realistic version of your workbook, with the formulas and VLookup data, etc.

Maybe delete a bunch of rows and if the worksheets are basically the same, delete any duplicates


Because of the nature of the workbook I am on, I don't have the liberty to post it as an example. I apologize. If there is no way to highlight all the cells at once, that's okay. I can move on to another project and keep doing this manually every day.

I can't really delete the data either.

Paul_Hossler
06-07-2018, 10:56 AM
Another thing to try is to step through the macro and see if there's a part taking a long time

Try this macro which looks at the dates which are now in row 1 to determine if you need to hide the column (you can try ver 2 if you want)

Click inside the macro and use F8 to step through this macro, and any other macros that it calls

You can get a feel for how long it takes to execute a statement, and possibly spot something

IF you hover the mouse over a variable, you can see its current value

F5 will run the macro to completion

22379




Option Explicit

Sub HideColumns()
Dim maxCol As Long, iCol As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

With ActiveSheet

.Columns.Hidden = False

maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = 1 To maxCol
If .Cells(1, iCol).Value > CLng(Now) + 3 Then ' was 4
.Columns(iCol).Hidden = True
ElseIf .Cells(1, iCol).Value < CLng(Now) - 13 Then
.Columns(iCol).Hidden = True
End If
Next iCol
End With
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub UnHideColumns()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
ActiveSheet.Columns.Hidden = False
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

emccracken
06-07-2018, 11:33 AM
Another thing to try is to step through the macro and see if there's a part taking a long time

Try this macro which looks at the dates which are now in row 1 to determine if you need to hide the column (you can try ver 2 if you want)

Click inside the macro and use F8 to step through this macro, and any other macros that it calls

You can get a feel for how long it takes to execute a statement, and possibly spot something


I found the part that takes so long. I help F8 down for about a minute during this part of the code:



If .Cells(4, iCol).Value > CLng(Now) + 3 Then ' was 4
.Columns(iCol).Hidden = True
ElseIf .Cells(4, iCol).Value < CLng(Now) - 13 Then
.Columns(iCol).Hidden = True
End If
Next iCol


and it took me through about 100 days. This is the loop that takes so long.

I do like your code much better than mine since it takes away the need for that extra row filled with "X"

Paul_Hossler
06-07-2018, 11:59 AM
I assume that the dates are really in row 4

You just need to press F8 and the macro will execute that statement.

I expected the looping to be the biggest time consumer, but try just press F8 + release F8 to just execute one statement to see which specific statement takes the time

I think that if you just hold down F8, it won't show any subs that are called

emccracken
06-07-2018, 12:32 PM
I assume that the dates are really in row 4

You just need to press F8 and the macro will execute that statement.

I expected the looping to be the biggest time consumer, but try just press F8 + release F8 to just execute one statement to see which specific statement takes the time

I think that if you just hold down F8, it won't show any subs that are called

The dates are in row 4.

I did try to press just once as well and ran through it quite a few times just doing that. There is no one step that takes a while. They all seem to run smoothly.

SamT
06-07-2018, 12:35 PM
they all take 3 mins to run.
Well... It's not the code. My code should not take more than a few milliseconds per "X".
Be sure and set Calculation to manual and Enable events to false. I left them out of my code.
you can pick up a Quite few CPU cycle by changing

If .Cells(4, iCol).Value > CLng(Now) + 3 Then
by Not computing CLng(Now) + 3, (and forcing VBA to convert numbers and dates,) every loop

Dim CheckValue as Date
CheckValue = DateAdd("d", 3, Date)
'
'
If .Cells(4, iCol).Value > CheckValue Then
'
'
'
If hours, minutes, and seconds are critical, change "Date" to "Now"

SamT
06-07-2018, 02:13 PM
Try this array driven code. It all goes into a Standard module. It is designed to be very versatile, For instance, later you want to hide columns in another sheet, just make an edited copy of HideColumns. If you decide you want to run it from a Button on a sheet, just make an edited copy of Hidecolumns in that sheet's code page.

Option Explicit

Public Sub HideColumnsOnActiveSheet()
Dim MaxDate As Date
Dim MinDate As Date
Dim WSht As Worksheet
Dim RowNum As Long

'Edit these values to suit
MaxDate = DateAdd("d", 4, Date)
MinDate = DateAdd("d", -13, Date)
Set WSht = ActiveSheet
RowNum = 4

Hidem MaxDate, MinDate, WSht, RowNum
End Sub

Public Sub Hidem(MaxDate As Date, MinDate As Date, WSht As Worksheet, RowNum As Long)
'This assumes that all columns are starting with column A.
'If otherwise, edit the HideCols(j) = i to suit
Dim AllCols As Variant
Dim HideCols As Variant
Dim ColNames As String
Dim i As Long
Dim j As Long

With WSht
AllCols = Range(.Cells(RowNum, "A"), .Cells(RowNum, "A").End(xlToRight))
ReDim HideCols(1 To UBound(AllCols))

j = 1
For i = LBound(AllCols) To UBound(AllCols)
If IsDate(AllCols(i)) Then
If AllCols(i) < MinDate Or AllCols(i) > MaxDate Then
HideCols(j) = i
j = j + 1
End If
End If
Next i

j = 1
Do While HideCols(j) <> "" Or HideCols(j) <> 0
ColNames = ColNames & .Columns(HideCols(j)).Address & ", "
Loop

ColNames = Left(ColNames, Len(ColNames) - 2)

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

.Range(ColNames).EntireColumn.Hidden = True
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub