I have code that uses a For loop to hide a number of columns based on a Cell value. The code is used in 7 sheets out of a Workbook that has 17 sheets in total (this information is relevant later).
Private Sub Worksheet_calculate()
Application.EnableEvents = False
On Error GoTo errorHandling
Dim controlCell As Range, tableToHide As Range
Set controlCell = Range("C12") 'Cell contains a formula to retrieve the value from a cell in a seperate sheet
Set tableToHide = Range("Table1") 'The name of the table where columns need to be shown/hidden based on controlCell value
tableToHide.EntireColumn.Hidden = False
For i = controlCell.Value To tableToHide.Columns.Count
tableToHide.Columns(i).EntireColumn.Hidden = True
Next i
errorHandling:
On Error GoTo 0
Application.EnableEvents = True
End Sub
I'm looking for a way to hide the columns without using a loop or a way to change this loop. The reason for wanting the change is because when this is used in its current form, changing any cell throughout the Workbook's 17 sheets results in a loading spinner showing for a few seconds. As you can imagine, that is not a great user experience.
You can hide all columns at once. Various ways to do so, eg
Dim startCol As Long
startCol = controlCell.value
Dim hideRange As Range
Set hideRange = tableToHide.Cells(1, startCol).Resize(1, tableToHide.Columns.Count - startCol + 1)
hideRange.EntireColumn.Hidden = True
I don't understand why you have this code inside the Worksheet_calculate() event: this causes the entire workbook to be checked every time a calculation is made.
Why don't you put that for-loop inside another macro, which you can run on demand, and use the Worksheet_calculate() event only to check the column you're actually calculating?
Related
I am new to coding in anything, this project is the first time I have coded. I am trying to hide multiple row based on individual requirement. The requirement is if in a specific cell of the same row there is a space or is empty, the row will be hidden, if it is hidden and there is anything else, the row will be shown. The code need to work on specific worksheet as I have multiple worksheet where there is row to hide or columns to hide at different place.
There are 2 different pieces of code that I tried which don't work.
This picture represent the Excel sheet I am currently trying to hide row:
My goal is to hide row between 8 to 37 if there is there is a space or if it is empty, depending what the code inside the cell point at for the cell A8 to A37. if I activate the code, in the image only the row 8, 9 and 10 should be visible, 11 to 37 should be hidden.
So far I have tried these two pieces of code:
Sub C1()
Set ws = ActiveWorkbook.Worksheets("FR-3-06_Jeux Prod.")
Dim C As range
For Each C In range("A8:A37")
If C.Value = " " Then
C.EntireRow.Hidden = True
Else
If C.Value = Empty Then
C.EntireRow.Hidden = True
Else
C.EntireRow.Hidden = False
End If
End If
Next C
End Sub
This code work as intended except that it is not tied to a sheet. "Set ws = ActiveWorkbook.Worksheets("FR-3-06_Jeux Prod.")" is not working as well as a couple other code I tried, they point to an error. So when I try to use this code it will work on the active sheet and not "FR-3-06_Jeux Prod."
Sub Hide_column_and_Row_F_3_6()
Dim NbreLigne As Integer
Dim tableau As range
Set wrkshtDoc = ActiveWorkbook.Worksheets("FR-3-06_Jeux Prod.")
Set tableau = wrkshtDoc.range("A8:A37")
NbreLigne = tableau.Rows.Count
For k = 1 To NbreLigne
If tableau(1, k) = " " Then
tableau(1, k).EntireRow.Hidden = True
ElseIf tableau(1, k) = Empty Then
tableau(1, k).EntireRow.Hidden = True
Else
tableau(1, k).EntireRow.Hidden = False
End If
Next k
End Sub
This code only works as intended when I try to hide columns as in replace "row" in the code with "columns". There is sheet in my file where is it columns I need to hide and since this code is working I tried to reuse it... what it is currently doing is hiding row with "test", line 8 only. It wont hide the empty cell.
what would be the error or what would be needed to hide row with the requirement? I know that code #2 work with columns...
You are almost there with code1, you only need to add:
For each C in ws.Range("A8:A38")
Because you add ws. in front of the Range, it knows which sheet to apply it on.
Good luck!
Hide Blank Rows
Option Explicit
Sub HideBlankRows()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("FR-3-06_Jeux Prod.")
Dim Cell As Range
For Each Cell In ws.Range("A8:A37").Cells
Cell.EntireRow.Hidden _
= IIf(Len(Trim(CStr(Cell.Value))) = 0, True, False)
Next Cell
End Sub
My main goal is to be able to autofilter merged cells in one column.In the picture below I want row 7-9 to disappear when I remove "6" from the autofilter menu. But as I have figured, I need the value "6" to be held in all the cells "L7:L9" in order for Excel to do so.
The number 6 is calculated by adding "Num1" and "Num2" (2 * 3) by the following function I have placed in "L7":
Function Exposure(arg1 As Range, arg2 As Range) As Variant
Application.EnableEvents = False
Application.Calculation = xlManual
If Application.ThisCell.Offset(, -1).Value <> "-" And Application.ThisCell.Offset(, -2).Value <> "-" Then
Exposure = Left(Application.ThisCell.Offset(, -1).Value, 1) * Left(Application.ThisCell.Offset(, -2).Value, 1)
End If
If Exposure = 0 Then Exposure = "-"
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Function
I put the following formula inside the merged cell "L7":=Exposure(K7;J7). Then formula is dragged down."Num1" and "Num2" are controlled by valdiation fields, drop-down menu.
My plan was to unmerge after calculating the Exposure Variant, fill the same value in the remaining rows, then re-merge the same area. So I wrote this stand alone Sub:
Sub WorkingSub(rng As Range)
'Set rng = ActiveCell.MergeArea
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value 'This line triggers recursion
Next i
rng.Offset(rng.Cells.Count).Copy 'Copies format from below
rng.PasteSpecial Paste:=xlPasteFormats 'Paste that keeps the values even after merging
End Sub
Which works on its own, but not when called inside the function above. After setting the first value, the function triggers "something", debug show the the function starting over, skipping the rng.PasteSpecial Paste:=xlPasteFormats code.
So my question to you guys is how do i write my function(s) to stop "recursing" and let me unmerge during the function call?
Or am I attacking this the wrong way? What would you do?
I am stuck with merged cells for lots of reasons, this is just one part of many inside this spreadsheet.
An interesting problem. You can capture the filter event through trapping a change in a calculation and then processing the rows of the table for visibility. I've made some assumptions for the initial table range assignment which may need some alteration.
The If Not VisRange Is Nothing Then is actually redundant as the prior line will throw a fit if an empty range is assigned, but I just kept it in. In order to get around having a null range, keep the header range in the initial MergedTableRange so there will always be a row visible
Within a cell either somewhere in the same worksheet or a 'dummy' worksheet
=SUBTOTAL(103,Sheet1!A3:H10) 'Or other table range
In the worksheet module code
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim MergedTableRange As Range: Set MergedTableRange = ws.Range("A2").CurrentRegion
Dim Cell As Range
Dim VisRange As Range: Set VisRange = MergedTableRange.SpecialCells(xlCellTypeVisible)
If Not VisRange Is Nothing Then
For Each Cell In VisRange
If Not Application.Intersect(Cell.MergeArea, VisRange).Address = Cell.MergeArea.Address Then
Cell.Rows.Hidden = True
End If
Next Cell
End If
End Sub
I came up with a different approach. Maybe there's a downside I'm missing. But my few test runs have succeeded.
I allready have a hidden sheet named "Template" where the formats for each new "#" is stored. So whenever the user wants to insert a new row, the template have the merged and the non-merged cells ready and insert is done through copy paste.
In that same sheet I made 2 merged rows in column 2, 3 merged cells in column 3 and so on:
This way I'm able to copy the correct number of merged rows to paste after filling the unmerged rows with their correct values.
I came to the conclusion that I could catch a Worksheet_change on the "Num1" and "Num2" columns instead of catching and canceling an autofilter call.
So I added:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("J:J")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
If Not Intersect(Target, Target.Worksheet.Range("K:K")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
End Sub
And the UnMergeMerge sub ended up being:
Sub UnMergeMerge(rng As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value
Next i
With Sheets("Template")
.Range(.Cells(8, rng.Cells.Count), .Cells(8 + rng.Cells.Count, rng.Cells.Count)).Copy
End With
rng.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Still not sure it's the fastest and best approach...Do you guys still believe catching, undoing and running a different autofilter would be more effective?
I have created a worksheet with 40 pages. I know it's impossible to Repeat Bottom Cells when printing, so I just repeated the Top Rows (which contains a Sum formula) to make the sheet more compact. But the problem is, the sum formula in the top row computes only data from the first page. Ist possible to compute the data in every page when printing, somehow like what we could do in Microsoft Access' header?
This should do the trick:
Sub SubSpecialPrinting()
'Declarations.
Dim IntCounter01 As Integer
Dim IntPagesToBePrinted As Integer
Dim LngRow As Long
Dim RngRangeWithFormula As Range
Dim RngSumRange As Range
Dim StrExistingFormula As String
Dim WksWorksheet01 As Worksheet
'Setting variables.
Set RngRangeWithFormula = Range("I1")
Set RngSumRange = Range("A1:A10")
Set WksWorksheet01 = RngSumRange.Parent
StrExistingFormula = RngRangeWithFormula.Formula
IntPagesToBePrinted = ExecuteExcel4Macro("GET.DOCUMENT(50)")
'Disabling interruption in case of error.
On Error Resume Next
'Covering all the pages to be printed.
For IntCounter01 = 1 To IntPagesToBePrinted
'Setting the formula in RngRangeWithFormula.
RngRangeWithFormula.Value = Excel.WorksheetFunction.Sum(RngSumRange)
'Printing the single given page.
WksWorksheet01.PrintOut From:=IntCounter01, _
To:=IntCounter01, _
Copies:=1, _
Collate:=True, _
IgnorePrintAreas:=False
'Setting LngRow equal rows of the page just printed.
LngRow = WksWorksheet01.HPageBreaks(IntCounter01).Location.Row - 1 - LngRow
'Setting RngSumRange for the next page to be printed.
Set RngSumRange = RngSumRange.Offset(LngRow, 0)
Next
'Reactivating interruption in case of error.
On Error GoTo 0
'Reporting the pre-existing formula in RngRangeWithFormula.
RngRangeWithFormula.Formula = StrExistingFormula
End Sub
Change RngRangeWithFormula and RngSumRange value accordingly to your needs. The subroutine will print the pages of the print area one by one. Before printing, it will change the value of the RngRangeWithFormula with the sum of the values in RngSumRange; the latter will change for each pages, shifting down for as many rows as the given page contains. At the end of the subroutine, the RngRangeWithFormula will have the same formula it had before the subroutine was run.
Since one should call the subroutine in order to print the sheet correctly, i've spent some hours looking for a way to obtain the same result via a function. I've found how to know to which page a given cell belongs, but I haven't found a way to dynamically use the page number while printing. In the end i've accepted the subroutine as the way to go. Still in order to avoid the pointless printing of the "uncorrect" sheet and to make it easier for the user, i've written this extra code to be put in the workbook module:
Public PubBlnDedicatedPrinting As Boolean
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'Checking if a dedicated printing is in process.
If PubBlnDedicatedPrinting = False Then
'Checking a specific sheet is active.
If ActiveSheet.Name = "INSERT YOUR SHEET NAME HERE" Then
'Asking if the user want to use the dedicated macro for printing.
Select Case MsgBox("Do you want to run the dedicated macro for printing?", vbYesNoCancel, "Dedicated macro")
Case Is = 6
'Setting PubBlnDedicatedPrinting value is set to true.
PubBlnDedicatedPrinting = True
'Running the dedicated macro.
Call SubSpecialPrinting
'Setting PubBlnDedicatedPrinting value is set to false.
PubBlnDedicatedPrinting = False
'Canceling any other printing procedure.
Cancel = True
Case Is = 7
'Proceeding with a classical printing.
Cancel = False
Case Is = 2
'Canceling any printing procedure.
Cancel = True
End Select
End If
End If
End Sub
To make it effective, you need to sobstitute the "INSERT YOUR SHEET NAME HERE" with the name of your sheet. Once the user will try to print the given sheet, Excel will ask him whether he wants to run the dedicated macro or to print it the classical way or neither or those.
Hello all brand new to coding here:
I am working on trying to set up views for a specific excel worksheet that I have. The worksheet has approximately 300 columns of data that is very cumbersome to navigate through. I have defined a named range for each column and have created some formulas to determine the list of named ranges on specific views eg. "namedrange_1, named range_2" etc.
I've entered some named ranges into the VBA code but noticed around 12 or so listings I get an 1004 Range reference error.
If I split the code into 3 rows and it appears to work. However I would like the code to be automated to what the formulated cell (listing of the named ranges for a specific view).
For example a formulated cell in another sheet currently appears as: "Namedrange_1, NamedRange_2, Etc"
Private Sub CMB_TAKEOFF_BASIC_Click()
Application.ScreenUpdating = False
Sheets("Pipe").Visible = True
Worksheets("Pipe").Activate
Call CMB_All_Click
Columns("B:XFD").Select
Selection.EntireColumn.Hidden = True
Range("NamedRange_1,NamedRange_2).EntireColumn.Hidden = False
Range("NamedRange_13,NamedRange_14).EntireColumn.Hidden = False
ActiveWindow.ScrollColumn = 1
Application.ScreenUpdating = True
End Sub
Looking for code to reference the named ranges list from calculation within an excel worksheet so I don't have to manually change the code every time a view is modified.
This is the complete code with some corrections. This works fine I tested it. Please give it a try.
Private Sub CMB_TAKEOFF_BASIC_Click()
Dim i As Integer
Dim arr() As String
Application.ScreenUpdating = False
Worksheets("Pipe").Visible = True
Worksheets("Pipe").Activate
'Call CMB_All_Click
Columns("B:XFD").EntireColumn.Hidden = True
'fill the array with values: split B20's value by commas.
arr = Split(Worksheets("VIEWS").Range("B20"), ",")
'for each value (named range) hide its column.
For i = 0 To UBound(arr)
Range(arr(i)).EntireColumn.Hidden = False
Next
ActiveWindow.ScrollColumn = 1
Application.ScreenUpdating = True
End Sub
I have a large spreadsheet of various chemicals and their specifications; however, not every chemical requires a value in each column so there are a lot of blank cells. I'm wondering if there's something I can do to hide a column if there are no values in it when I select it from a drop-down list filter?
For example, I click on the drop-down list and select "potassium hydroxide" and I want it to hide the columns "Moisture" because there are no values in it.
what it looks like now:
I tried using some VBA code earlier but I don't seem to get how to incorporate it into the drop-down list filter.
Unfortunately, there is no Event for a filter being applied/changed to fire off a macro. However, you can manipulate the Event, Worksheet_Calculate, to achieve desired result since modifying a filter calculates the sheet. I.E. every time the sheet calculates, the macro is triggered!
So now we need to link a filter to a calculation. Any equation will do for this so I am just setting K1 = L1 in my example. Ideally, this will be somewhere out of sight (Ideally next to your last used column header to avoid hiding columns not being used)
The macro is making use of the Aggregate function by counting the instances of non-empty cells for visible rows only. When a filter is applied, any columns that only have 1 visible cell will be hidden. We are using 1 as a base line since all columns will at least have 1 visible cell due to header.
Paste the below code in VBE on sheet Specifications. This will not work in a module or workbook template.
Option Explicit
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Specifications")
Dim LCol As Long: LCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error GoTo SafeExit
Dim HeaderCell As Range
Application.ScreenUpdating = False
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
For Each HeaderCell In ws.Range(ws.Cells(1, 1), ws.Cells(1, LCol))
If Application.WorksheetFunction.Aggregate(3, 7, HeaderCell.EntireColumn) = 1 Then
HeaderCell.EntireColumn.Hidden = True
End If
Next HeaderCell
SafeExit:
Application.ScreenUpdating = True
End Sub
TLDR
Make sure Sheet has at least 1 equation. When you apply/modify a filter, you force a calculation. When you force a calculation, you trigger the macro. When you trigger the macro, you hide all columns that only have 1 visible cell (which will be the header).
If this runs slow, you can add your range to a Union of columns and hide the Union (all columns meeting your criteria) once loop is complete.
Much in the line of #urdearboy, I'd go as follows
place the following formula in any cell in row 1:
=SUBTOTAL(3,A:A)
then place the following code in the "Specification" sheet code pane:
Private Sub Worksheet_Calculate()
Dim col As Range
With Me.UsedRange
For Each col In .Offset(, 1).Resize(, .Columns.Count - 1).Columns
col.EntireColumn.Hidden = Application.WorksheetFunction.Subtotal(103, col) = 1
Next
End With
End Sub
as you may notice, since the same chemical can appear more than one in in column A (e.g.: "Sulfamic Acid"), a column gets hidden only if all of its visible cells are empty
try this code:
For i = 1 To 500
If Application.WorksheetFunction.Count(Columns(i)) = 1 Then
ActiveSheet.Columns(i).Hidden = True
End If
Next