I have Sheet 1 containing information that are drawn into Sheet 2. Only Sheet 1 will be edited for future updates.
I would like to hide rows within a range in Sheet 2 that are "" or 0, based on Sheet 1 input.
This code (in Sheet 2) currently works for me:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim c As Range
For Each c In Me.Range("P15:P22")
If c.Value = 0 Or c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
The only issue is that there is an obvious lag in loading the sheet.
To resolve this, I have tried moving the code to Sheet 1 instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlManual
Sheet2.Activate
Dim c As Range
For Each c In Me.Range("P15:P22")
If c.Value = 0 Or c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
Sheet1.Activate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
This edit is not working for me. Upon a change in Sheet 1, the linked cell in Sheet is not updated and the relevant rows are not being hidden.
Could anyone kindly point out if there's an alternative approach to resolve this issue?
Related
I'm trying to create an Excel log file using VBA. The idea is that I have columns named Tasks and By and every time a user inputs a certain task in the column cell, the cell next to it (the By column cell) would display his user name as shown in the screenshot.
I have finished the application but every time I try to test it it gives me different results and none of these results are the intended so if some one would pay a look at the code I would be glad.
Private Sub Workbook_Open()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.CalculateBeforeSave = False
Dim serialRange As Excel.Range
Set serialRange = ActiveSheet.Range("A2:A200")
Dim taskRange As Excel.Range
Set taskRange = ActiveSheet.Range("B2:B200")
For Each cell In serialRange
Dim rownumber As Integer
rownumber = ActiveCell.Row
Dim cellValue As Integer
cellValue = cell.Value
If (ActiveSheet.Range("A1").Value = "") Then
cellValue = Null
Else
cellValue = rownumber - 1
End If
Next
For Each cell In taskRange
If (cell.Value = "") Then
cell.Value = ""
Else
ActiveCell.Offset(2).Value = Environ("username")
End If
Next
Application.ScreenUpdating = True
ActiveWorkbook.Save
Application.EnableEvents = True
Application.CalculateBeforeSave = True
Application.Calculation = xlCalculationManual
End Sub
couple of issues I see with the code:
The code only runs when workbook is opened. If that is by design then fine, I moved the code to Workbook_SheetCalculate to test it
Using ActiveCell and ActiveSheet can cause some real issues. For instance, when I test the code, it puts my UserName in the cell 2 cels down from whatever cell is active, not in the column next to the cell it is evaluating. This is due to the use of ActiveCell when you SHOULD be using cell and the offset should be (0,1) not (2)
For Each cell In taskRange
If (cell.Value = "") Then
cell.Value = ""
Else
cell.Offset(0, 1).Value = Environ("username")
End If
Next
You never turn calculation back to automatic (in the last section of your code, you set it to manual, which you did in the first part of your code)
Saving the workbook should occur after you re-enable all of the event handling
Application.EnableEvents = true
Application.ScreenUpdating = true
Application.Calculation =xlCalculationAutomatic
Application.CalculateBeforeSave = true
ActiveWorkbook.Save
I have a spreadsheet which hides all rows except those designated by a date and a named region like so:
'Get week no value...
wk = Range("$B$2").Value
'If value changes...
If Target.Address = "$B$2" Then
'Hide all rows/weeks...
Range("allWeeks").Select
Application.Selection.EntireRow.Hidden = True
'...but show week selected by 'wk'
Range(wk).Select
Application.Selection.EntireRow.Hidden = False
All works great. However. Within each named week I have hidden calculation rows defined by "HC" in column A of the row to be hidden. The display of Range(wk) unhides those hidden rows so I introduce a loop to close all the "HC" hidden columns
Dim x As Integer
For x = 1 To 1500
If Sheet1.Cells(x, 1).Value = "HC" Then
Sheet1.Rows(x).Hidden = True
End If
Next
End Sub
The result is that it kinda works but I have to wait several seconds for the process to complete every time I type into a cell which is making the sheet almost unworkable. Any pointers would be appreciated.
Generally you want to build up a range of rows to hide within the loop and then afterwards hide that range separately. You can build the range to hide using he Union() function like so:
Option Explicit
Sub HideRows()
Dim mainRng As Range
Set mainRng = Range("A2:A" & Range("A" & Rows.count).End(xlUp).Row)
Dim unionRng As Range
Dim i As Long
For i = mainRng.Row To mainRng.Row + mainRng.Rows.count - 1
If Cells(i, 1).Value2 = "HC" Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, Cells(i, 1))
Else
Set unionRng = Cells(i, 1)
End If
End If
Next i
If Not unionRng Is Nothing Then unionRng.EntireRow.Hidden = True
End Sub
Sometimes when you want to update too many things at once, the UI becomes a bit unresponsive.
I've found that disabling UI updates while doing those changes, speeds things up by an order of magnitude:
Sub XXX()
...
On Error GoTo EH
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.StatusBar = "I'm working on it..."
' do lots of changes in cells, rows, sheets...
' Undo the accel changes:
CleanUp:
On Error Resume Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.StatusBar = False
Exit Sub
EH:
' Do error handling
MsgBox "Error found: " & Err.Description
GoTo CleanUp
End Sub
See https://learn.microsoft.com/en-us/office/vba/api/excel.application.screenupdating
and Effect of Screen Updating
Guys,
can you help me with my problem.
What I need to do is to make code, that will HIDE entire row, if for example value in B10 will be = 100.
Thanks in advance
Try something like this
If Range("B10").Value = 100 Then
Range("B10").EntireRow.Hidden = True
End If
I think I solved my problem.
Used this (not sure if there is anything unnecessary):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
LastRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
On Error Resume Next
For Each c In Range("B1:B" & LastRow)
If c.Value = 100 Then
c.EntireRow.Hidden = True
ElseIf c.Value <> 100 Then
c.EntireRow.Hidden = False
End If
Next
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I'm trying to hide all rows in a worksheet if a reference cell has no text in it. I'm using the following formula
Option Explicit
Private Sub Worksheet_Activate()
Dim r As Range, c As Range
Set r = Range("d4:f1000")
Application.ScreenUpdating = False
For Each c In r
If Len(c.Text) = 0 Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
Application.ScreenUpdating = True
End Sub
When I run it it runs indefinitely, and I have to exit the program in Task Manager. I think this is happening because I haven't initially defined c. Am I correct about this?
Thank you for taking the time to respond!
first off you can shortened and speed up your code like follows:
Option Explicit
Private Sub Worksheet_Activate1()
Dim r As Range, c As Range
Set r = Range("d4:f1000")
Application.ScreenUpdating = False
For Each c In r
c.EntireRow.Hidden = Len(c.Text) = 0
Next c
Application.ScreenUpdating = True
End Sub
but if you're after hiding all rows where range D4:F100 cells in the same row are blank, then you can use this code:
Private Sub Worksheet_Activate4()
Application.ScreenUpdating = False
With Range("D4:F1000") '<-- reference your range
With .Columns(1).SpecialCells(xlCellTypeBlanks) '<--| reference its 1st column blank cells
With .Offset(, 1).SpecialCells(xlCellTypeBlanks) '<--| reference referenced blank cells whose side cell is blank
With .Offset(, 1).SpecialCells(xlCellTypeBlanks) '<--| reference referenced blank cells whose side cell is blank
.EntireRow.Hidden = True '<--| hide rows when all three cells are blank
End With
End With
End With
End With
Application.ScreenUpdating = True
End Sub
which can be made much less verbose like follows:
Private Sub Worksheet_Activate5()
Application.ScreenUpdating = False
Range("D4:F1000") _
.Columns(1).SpecialCells(xlCellTypeBlanks) _
.Offset(, 1).SpecialCells(xlCellTypeBlanks) _
.Offset(, 1).SpecialCells(xlCellTypeBlanks) _
.EntireRow.Hidden = True '<--| hide rows when all three cells are blank
Application.ScreenUpdating = True
End Sub
with the only caveat that should no rows match that criteria it'd return an error
should this be an issue then just add On Error Resume Next at the top of the sub
I'm trying to write some code to Hide columns if the first 3 characters of cells in a range equal the contents of another. I have the code for hiding columns if cells in a range are blank as this;-
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, cell As Range
On Error GoTo ErrHandler
Set r = Me.Range("C8:R8")
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each cell In r
If cell.Value = "" Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
Next
ErrHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
And the code for identifiying the first 3 charcters of a cell;-
Dim LResult As String
LResult = Left ("Alphabet",3)
But how do I combine the two, referencing a specific cell rather than "Alphabet"?
Cant get this to work - any suggestions?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, cell As Range
On Error GoTo ErrHandler
Set r = Me.Range("B7:CG7")
Application.ScreenUpdating = False
Application.EnableEvents = False
Row = 1
col = 1
For Each cell In r
If cell.Value = "" And Left(cell.Value, 3) = cell(Row, col).Value Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
Next
ErrHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Cheers
You have almost the working code. You are comparing cell.Value to an empty string - now just apply Left to it
LResult = Left (cell.Value,3)
Edit:
row = 20
col = 30
For Each cell In r
If cell.Value = "" and Left (cell.Value,3) = Cell(row, col).Value Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
where you want data from cell at row and col (I used 20, 30 as the example)