I am trying to create a macro that hides rows if a cell in a specific column contains a 0 value.
I have found a macro from another forum to use that will hide the rows (below) but it will only hide rows the first time the data gets refreshed. I am using data validation cells at the top of the sheet that pulls in data from another sheet to populate reference data (and the rest of the sheet uses SUMIFS).
When my team updates the cell to select various options (Ex: USA, Asia, Europe, All), I need the macro to run again to hide any cells that contain a 0 value. I also can't have a macro that will mess with the SUMIFS formulas being used in the sheet.
Current formula I have:
Sub HideRows()
Application.ScreenUpdating = False
Application.Calculation = xlManual
For Each c In Range("E7:E153")
If c.Value = 0 Then Rows(c.Row).Hidden = True
Next
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
I think all I need is to add some sort of rerun or loop lines at the end but am not sure where to go from here. Any help would be greatly appreciated.
TYVM.
You could use the Worksheet_Change event.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
Application.ScreenUpdating = False
Application.Calculation = xlManual
For Each c In Range("E7:E153")
If c.Value = 0 Then Rows(c.Row).Hidden = True Else Rows(c.Row).Hidden = False
Next
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "You just changed " & Target.Address
End Sub
borrowed from http://www.ozgrid.com/VBA/run-macros-change.htm
Just Reference target.Address to the specific cells that chages, and then have it call HideRows
If you need to unhide all rows before hand just add this code to your procedure ActiveSheet.Cells.EntireRow.Hidden = False
Related
I have a sheet that is used for sales entry, that has 15 different columns that get formatted based on what is entered in the cell. It's simple formatting, converting to proper case, things like that.
The shortened version of the code is:
Private Sub Worksheet_Change(ByVal target As Range)
On Error GoTo Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False:
Application.Calculation = xlCalculationManual ' etc..
Dim rName As String
If Not (Application.Intersect(target, Range("C2:C" & Me.Cells(Me.Rows.Count,"C").End(xlDown).Row)) Is Nothing) Then
rName = target.Value2
target.Value2 = UCase(Trim(rName))
End If
14x more above the above (1 each column)
Cleanup:
Application.EnableEvents = True: Application.ScreenUpdating = True:
Application.Calculation = xlCalculationAutomatic ' etc..
The reason I have it set to manual, then automatic, is because if I don't, Excel crawls to a halt. I'm assuming because when a user enters data, it changes values for hidden columns, and triggers the Change event again. The way it works now, is fine, however there is just a second or two delay after each cell is checked and formatted after a user enters the data, so ultimately I'm wondering if there is a quicker way to do it.
Thanks!
One obvious issues:
Me.Cells(Me.Rows.Count,"C").End(xlDown).Row 'returns row 1,048,576
should be
Me.Cells(Me.Rows.Count,"C").End(xlUp).Row
Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 Then
If Not (Application.Intersect(Target, Me.UsedRange.Columns("C")) Is Nothing) Then
Application.EnableEvents = False
Application.Calculation = xlCalculationManual ' etc..
On Error Resume Next
Target.Value2 = UCase$(Trim$(Target.Value2))
On Error GoTo 0
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic ' etc..
End If
End If
End Sub
Notes:
turning Off and On Application.ScreenUpdating takes longer than updating the cell
String versions (Trim$) are significantly faster ~ approx 10-30%...", and so is UCase$()
Try your intersect as,
If Not Application.Intersect(target, target.parent.usedrange) Is Nothing Then
The worksheet's .UsedRange property is decided beforehand. If you made an entry outside the usedrange, the usedrange would instantly expand to encompass it. This known as 'overhead' and it's one of the reasons that vba is slower than C or hex.
After you've determined that one or more cells in target is involved with something you want to do, parse each cell in target to determine how it should be processed.
you may try this:
Private Sub Worksheet_Change(ByVal target As Range)
If Intersect(target, Columns("C:Q")) Is Nothing Then Exit Sub ' exit if changed cells are completely outside relevant columns (change "C:Q" to your actual relevant columns indexes)
Application.EnableEvents = False: Application.ScreenUpdating = False:
Application.Calculation = xlCalculationManual ' etc..
On Error GoTo Cleanup
With Intersect(target, Intersect(UsedRange, Columns("C:Q"))) 'consider only changed cells in relevant columns (change "C:Q" to your actual relevant columns indexes)
.Value2 = UCase(Trim(.Value2))
End With
Cleanup:
Application.EnableEvents = True: Application.ScreenUpdating = True:
Application.Calculation = xlCalculationAutomatic ' etc..
End Sub
Good morning
Basically I am importing index data from the web (abcbourse.com) and I make it refresh every minutes.
I created a macro in order to recorder historical values of each index (starting with the CAC40 as you can see in the screenshot, with new values going on column E every minute (each time the data is automatically refreshed)
Here is my macro, working well (see Column E of the screenshot):
Sub Historical_Index()
Dim LastLRow As Integer, CurrentIndexValue As Single
LastRow = Range("E" & Rows.Count).End(xlUp).Row
CurrentIndexValue = Range("B1")
Do
If Not IsEmpty(CurrentIndexValue) = True Then
Cells(LastRow + 1, 5).Value = CurrentIndexValue
Exit Do
End If
Loop
End Sub
My problem is, I want this macro to run every time the data is refreshed. I initially used a
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Application.EnableEvents = False
Call Historical_Index
Application.EnableEvents = True
End If
End Sub
And this is indeed calling my macro but only if I change B2 manually. If I wait for the data to be refreshed automatically my macro is not called (even though the data has changed).
I would like to know what to do in order to automate this process, I need your help.
Thanks in advance
Ps: I don’t know if it matters, but my macro is saved in VBAProject(“this document”) > Sheet2 (Sheet2)
Please try the below for the range B1:B8:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.Range("B1:B8")) Is Nothing Then
Application.EnableEvents = False
Call Historical_Index
Application.EnableEvents = True
End If
End Sub
or if you want to check only B2:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.Range("B2")) Is Nothing Then
Application.EnableEvents = False
Call Historical_Index
Application.EnableEvents = True
End If
End Sub
I'm using this current code to update a pivot table filter based on a cell value (E1) within the same sheet. What i would like to do is to update a filter based on a cell in a sheet named summary. If I set the filed in the current filed equal to the cell in the summary I need to press f2 and enter otherwise it won't work. I'm sure a little bit of tweaking and my code could work for it.
Any tips?
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Range("E1")
If Target Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Sheets("Tech Pivot Table").PivotTables("PivotTable2").PivotCache.Refresh
With Me.PivotTables("PivotTable2")
.PivotCache.Refresh
.PivotFields("Name").CurrentPage = Target.Value
End With
Application.EnableEvents = True
End Sub
I think the problem is you're changing the value the Target variable up front when you should be checking to see if Target = "E1". Try the code below and let me know if it works.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("E1") Then
If Target Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Sheets("Tech Pivot Table").PivotTables("PivotTable2").PivotCache.Refresh
With Me.PivotTables("PivotTable2")
.PivotCache.Refresh
.PivotFields("Name").CurrentPage = Target.Value
End With
Application.EnableEvents = True
End If
End Sub
I did a program in VBA to copy the formulas in each cell in a specific column, I have 30501 points and the program is really slow even to calculate 100 points, there is a better way to do so?
Sub Copyformulas()
Dim i As Integer
Dim cell As Range
Dim referenceRange As Range
Dim a As String
a = "$T$30510"
Set range1= ActiveSheet.Range("A1:A30510")
Set myrange = Range("T16:T30510")
i = 16
Do Until Cells(20, 30510)
With range1
For Each cell In myrange
If cell.HasFormula Then
Cells(i, 35).Value = cell.Address
Cells(i, 36).Value = "'" & CStr(cell.Formula)
i = i + 1
End If
Next
End With
Loop
End Sub
You can use SpecialCells to refine your range. You don't need to use ActiveSheet it is implied.
Set rSource = Range("A16:A30510").SpecialCells(xlCellTypeFormulas)
Sub Copyformulas()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim c As Range
Dim rSource As Range
Set rSource = ActiveSheet.Range("A16:A30510").SpecialCells(xlCellTypeFormulas)
For Each c In rSource
c.Offset(0, 34) = c.Address
c.Offset(0, 35) = "'" & c.Formula
Next
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Try adding the following:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
... Your Code ...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
You may only need the first one, but they are all good practice in using. Also, where are you using the With ... End With statement? I don't see any use of it in the block.
It is good practice to use Option Explicit at the top of the module. And range1 and myrange are not declared.
Application.Calculation
When a worksheet is accessed or a range's precedents has changed, Excel will automatically recalculate the formulas on the worksheet. Since you are looping over 30,000 times, this causes Excel to recalculate each time through the loop and, thus, slows down performance.
Application.ScreenUpdating
This line stops Excel from screen flashes and other things that occur as the macro runs.
Application.EnableEvents
This line turns off events, such as Worksheet_Change, so that the event is not triggered. If it is not turned off then any time a change occurs on the worksheet the code in the change event will run. If you have a Worksheet_SelectionChange event then code will run every time you select a different cell. These events are written in the worksheet or workbook objects located in the project window of the VBE and there are many events to choose from. Here is a very simple illustration. Place the following in the Sheet1 object in the project window:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "Hi!"
End Sub
Now click around on the worksheet. You see it responds to each selection change. Now place the following in a regular module:
Sub TestEnableEvents()
Application.EnableEvents = False
ActiveCell.Offset(1, 0).Select
Application.EnableEvents = True
End Sub
When you run the above code the message box will not be triggered.
I am writing a short macro to hide all customers that have no current sales for the current year. The YTD sales are in the K column (specifically K10-250). Those cells use a vlookup to pull data from another tab where we dump data. My question is why on earth would this macro take 10-15minutes to run? I have a similar macro on another spreadsheet that takes only 2-3 minutes for over 1,500 rows. I have already turned off screen updating. I can't think of anything else that would speed it up.
Sub HideNoSlackers()
'
' HideNoSlackers Macro
'
'
Application.ScreenUpdating = False
'
Sheets("CONSOLIDATED DATA").Select
Dim cell As Range
For Each cell In Range("K10:K250")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If
Next
End Sub
You might want the calculation to be set Manual before hiding the rows? Also you can get rid of If statements in your case. Try this:
Sub HideNoSlackers()
Dim cell As Range, lCalcState As Long
Application.ScreenUpdating = False
' Record the original Calculation state and set it to Manual
lCalcState = Application.Calculation
Application.Calculation = xlCalculationManual
For Each cell In ThisWorkbook.Worksheets("CONSOLIDATED DATA").Range("K10:K250")
cell.EntireRow.Hidden = (cell.Value = 0)
Next
' Restore the original Calculation state
Application.Calculation = lCalcState
Application.ScreenUpdating = True ' Don't forget set ScreenUpdating back to True!
End Sub
Sub HideNoSlackers()
Dim cell As Range, rng As Range, rngHide As Range
Set rng = Sheets("CONSOLIDATED DATA").Range("K10:K250")
rng.EntireRow.Hidden = False
For Each cell In rng.Cells
If cell.Value = 0 Then
If Not rngHide Is Nothing Then
Set rngHide = Application.Union(rngHide, cell)
Else
Set rngHide = cell
End If
End If
Next
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub
Why are you doing this with a macro?
If you create a table over the data, you can set up a filter on the sales column that will show only those where sales<> 0.
Macros are useful in excel but the majority of actions that people turn to macros for can be done natively in excel.
there must be something else that's wrong. Try without .Selecting the sheet but that's not a huge improvement
Note rows are visible by default so the Else statement should be optional really.
Sub HideNoSlackers()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Sheets("CONSOLIDATED DATA").Cells.EntireRow.Hidden = False
Dim cell As Range
For Each cell In Sheets("CONSOLIDATED DATA").Range("K10:K250")
If cell.Value = 0 Then cell.EntireRow.Hidden = True
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
the shortest code to achieve the same Goal in a very different way:
Sub column_K_not_NULL
Sheets("CONSOLIDATED DATA").Select
If ActiveSheet.FilterMode Then Selection.AutoFilter 'if an autofilter already exists this is removed
ActiveSheet.Range("$K$10:$K$250").AutoFilter Field:=1, Criteria1:="<>0"
End Sub
of course you could put in the standard minimums like
application.calculation = Manual
Application.ScreenUpdating = False
and other way round at the end.
Max
Try disabling page breaks. I had a similar problem that would happen after someone printed from the sheet. This turned on page breaks, and subsequent runs of the script would take forever.
ActiveSheet.DisplayPageBreaks = False
We found out, that the program Syncplicity in the Version 4.1.0.1533 slows down macros up to 15times slower because events trigger syncplicity.
with
Application.EnableEvents = False
;do your job here
Application.EnableEvents = True
the speed is back.