I have code within a workbook that works exactly how I want it to, but I am looking for ways to increase its efficiency/speed. My thought would be to add a union for all blank rows and hide that range all at once. Can this be done?
Sub HideRws()
Dim Rng As Range, Cl As Range
With Sheet3
For Each Cl In .Range("A11:A60")
Cl.EntireRow.Hidden = Cl.Value = ""
Next Cl
For Each Rng In .Range("A71:A120, A131:A180, A190:A239").Areas
If Rng(1) = "" Then
Rng.Offset(-6).Resize(58).EntireRow.Hidden = True
Else
For Each Cl In Rng
Cl.EntireRow.Hidden = Cl.Value = ""
Next Cl
End If
Next Rng
End With
End Sub
I think this does the same thing:
Sub HideRows()
With Sheet3
.Range("A11:A60").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
For Each Rng In .Range("A71:A120, A131:A180, A190:A239").Areas
If Rng(1) = "" Then
Rng.Offset(-6).Resize(58).EntireRow.Hidden = True
Else
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End If
Next Rng
End With
End Sub
Related
Imagine we have three columns in Excel (No. Name Ticket) and we need to hide from the spreadsheet the user name Sam and ticket name ACCELA. I created the following code but it does not work.
Sub Hide_Rows()
Dim c As Range
For Each c In ActiveSheet.Range("A2:C37")
If c.Value = "Sam" Then
If c.Value = "ACCELA" Then
c.EntireRow.Hidden = False
End If
End If
Next c
End Sub
I also tried the following and did not work:
Sub Hide_Rows_Toggle()
Dim c As Range
For Each c In Range("A2:C37").Cells
If c.Value = "Sam" And c.Value = "ACCELA" Then
'The following line changes the hidden property to
'the opposite of it's current setting for the row.
c.EntireRow.Hidden = Not c.EntireRow.Hidden
End If
Next c
End Sub
Any help please.
Try this.
Sub Hide_Rows()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") ' change
Dim unionRange As Range
Dim c As Range
ws.Range("B2:B37").EntireRow.Hidden = False
For Each c In ws.Range("B2:B37")
If c = "Sam" And c.Offset(, 1) = "ACCELA" Then
If Not unionRange Is Nothing Then
Set unionRange = Union(unionRange, c)
Else
Set unionRange = c
End If
End If
Next c
If Not unionRange Is Nothing Then
unionRange.EntireRow.Hidden = True
End If
End Sub
you could use AutoFilter
Sub Hide_Rows()
Dim rngToHide As Range
With Worksheets("mySheetName").Range("B1:C37") ' change "mySheetName" to yur actual sheet name
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="Sam"
.AutoFilter Field:=2, Criteria1:="ACCELA"
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set rngToHide = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
.Parent.AutoFilterMode = False
End With
If Not rngToHide Is Nothing Then rngToHide.EntireRow.Hidden = True
End Sub
I am facing one problem and I don't understand how it can be fixed. It is a simple code: if range("A1:A100") = "Product" then range("B1:B100") should have automatically 1 (this range is empty). So for example: If anyone writes in A1 = Product then B1 should automatically have 1. Else, if Product is deleted from A1, then 1 should be deleted from B1. My code is below:
Thanks in advance!
Sub product(o As Long)
If Cells(o, "A") = "Product" And Cells(o, "B") = "" Then
Cells(o, "B") = "1"
ElseIf Cells(o, "A") = "" And Cells(o, "B") = "1" Then
Cells(o, "B") = ""
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim cell1 As Range
Set cell = Intersect(Range("b1:b100"), Target)
If Not cell Is Nothing Then
For Each cell1 In cell.Rows
product cell1.Row
Next cell1
End If
End Sub
In the worksheet's code sheet,
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Columns(1), Target) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Columns(1), Target, Target.Parent.UsedRange)
Select Case LCase(trgt.Value2)
Case "product"
trgt.Offset(0, 1) = 1
Case ""
trgt.Offset(0, 1) = vbnullstring
Case Else
'do nothing
End Select
Next trgt
End If
safe_exit:
Application.EnableEvents = True
End Sub
Actually just a small fix is needed:
Set cell = Intersect(Range("A1:B100"), Target)
instead of b1:b100. You can even consider Range("A:B"), if you want to leave it active for the whole column.
I have written a macro, which should read the value in every sheet (Row and Column) based on the value given it should Lock the cell or leave it unlocked. The way the code is written right now it takes forever to compute. I was suggested it be done using arrays. However the array are also not working
My excel file has got 15 sheets.
My Code is below.
Private Sub Workbook_Open()
Dim sh As Object
Dim sheetnames As String
Dim i As Integer
Dim col As Range
Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
Dim rngCell As Variant
Application.ScreenUpdating = False
For Each sh In Sheets 'First Each
If sh.Name <> "Configuration" Then 'Configuration If
sheetnames = sh.Name
Worksheets(sheetnames).Activate
ActiveSheet.Unprotect Password:="sos"
For Each rngCell In Range("I22:BI300")
If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
rngCell.Locked = True
rngCell.Font.Color = -16776961
Else
rngCell.Locked = False
rngCell.Font.ColorIndex = xlAutomatic
End If
Next rngCell
ActiveSheet.Protect Password:="sos"
End If 'End of Configuration If
Next sh 'End of First Each
Sheets(1).Select
End Sub
Based on a combination of values in Column and Rows the result should produce values.
Column Row Value
Lock Lock Lock
Unlock Lock Lock
Lock Unlock Lock
Unlock Unlock Unlock
I'm not sure how arrays would speed this up as really it is the locking/unlocking of cells which is causing the main speed issue (Although arrays could improve the read time). Anyway, I'd suggest setting the values you wish to lock/unlock to a range and then doing them all in one go instead of individually as that will be where your main performance impact is.
Private Sub Workbook_Open()
Dim sh As Object
Dim sheetnames As String
Dim i As Integer
Dim col As Range, LockRng As Range, UnLockRng As Range
Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
Dim rngCell As Variant
Application.ScreenUpdating = False
For Each sh In Sheets 'First Each
' Reset Ranges for each sheet
Set LockRng = Nothing
Set UnLockRng = Nothing
If sh.Name <> "Configuration" Then 'Configuration If
sheetnames = sh.Name
Worksheets(sheetnames).Activate
ActiveSheet.Unprotect Password:="sos"
For Each rngCell In Range("I22:BI300")
If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") _
Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") _
Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
' Create LockRng
If LockRng Is Nothing Then
Set LockRng = rngCell
Else
Set LockRng = Union(LockRng, rngCell)
End If
Else
' Create UnLockRng
If UnLockRng Is Nothing Then
Set UnLockRng = rngCell
Else
Set UnLockRng = Union(UnLockRng, rngCell)
End If
End If
Next rngCell
ActiveSheet.Protect Password:="sos"
End If 'End of Configuration If
' Lock all cells in LockRng
If Not LockRng Is Nothing Then
LockRng.Locked = True
LockRng.Font.Color = -16776961
End If
' Unlock all cells in UnLockRng
If Not UnLockRng Is Nothing Then
UnLockRng.Locked = False
UnLockRng.Font.ColorIndex = xlAutomatic
End If
Next sh 'End of First Each
Sheets(1).Select
End Sub
I am currently trying to hide certain columns if Row(8:8) meets certain criteria. My For Each loop is currently not working. Could someone point me in the right direction?
Sub hide()
' hide Macro
'
Dim rng As Range
For Each rng In Range("F:BJ").Columns
If Rows.Range("8") = "Test" Or Rows.Range("8") = "Test1" Then
Column.rng.EntireColumn.Hidden = True
End If
Next rng
End Sub
You can do it this way:
Dim rng As Range
For Each rng In Range("F8:BJ8")
If rng.Value = "Test" Or rng.Value = "Test1" Then
rng.EntireColumn.Hidden = True
End If
Next rng
Presumably, you would want to unhide the columns if the value in row 8 was changed programmatically or otherwise.
Dim rng As Range
With Worksheets("Sheet1")
For Each rng In .Range("F8:BJ8")
rng.EntireColumn.Hidden = _
CBool(LCase(rng.Value) = "test" Or LCase(rng.Value) = "test1")
Next rng
End With
The Rows and Columns ranges refer to the whole spreadsheet if you don't specify a range.
Sub hideColumn()
Dim rng As Range
For Each rng In Range("F:BJ").Columns
If rng.Rows(8) = "Test" Or rng.Rows(8) = "Test1" Then
rng.EntireColumn.Hidden = True
End If
Next rng
End Sub
Hey have a quick question I am writing a code that hides a list of worksheets based on whether the field next to the worksheet name is yes or no. Therefore, I have list of 29 worksheets, I want my code to look at the field next to that name, and if its yes it while show it and if it is no It will hide it.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name = Worksheets("Settings").Range("B4:B32") _
And Worksheets("Setting").Range("C4:C32") = "Yes" Then
ws.Visible = True
End If
If ws.Name = Worksheets("Settings").Range("B4:B32") _
And Worksheets("Setting").Range("C4:C32") = "No" Then
ws.Visible = True
End If
Next ws
End Sub
I run this and keep getting a mismatch error i am new to programming so i don't think i am calling stuff correctly
I believe the following code should suit your needs:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsSettings As Worksheet
Dim wsHideShow As Worksheet
Dim rngSheets As Range
Dim xlCell As Range
Dim sheetName As String
Set wsSettings = ThisWorkbook.Worksheets("Settings")
Set rngSheets = wsSettings.Range("B4:B32")
For Each xlCell In rngSheets
sheetName = xlCell.Value
If sheetName <> "" Then
Set wsHideShow = ThisWorkbook.Worksheets(sheetName)
If xlCell.Offset(0, 1).Value = "yes" Then
wsHideShow.Visible = False
Else
wsHideShow.Visible = True
End If
End If
Next xlCell
End Sub
Instead of looping through your worksheets, loop through your list and hide/show the worksheets accordingly.
This code runs in a standard module. It assumes that the master is Settings rather than Setting
It loops over the table as well as the sheets:
Sub DisplayOrHideSheets()
Dim sh As Worksheet
For Each ws In Sheets
v = ws.Name
For Each r In Worksheets("Settings").Range("B4:B32")
If r.Value = v Then
If r.Offset(0, 1) = "Yes" Then
ws.Visible = True
Else
ws.Visible = False
End If
End If
Next r
Next ws
End Sub
Being slow in typing... but... my suggestion would be:
Private Sub WorkSheet_Change(ByVal Target as range)
If (Target.Row >= 4 And Target.Row <= 32 And Target.Column = 2) Then
Dim i as Integer
For i=0 To 28 Step 1
If Range("B" & 2 + i).Value = "YES" Then
ThisWorkBook.Worksheets(Range("A" & 2 + i).Value).Visible = True
Else
ThisWorkBook.Worksheets(Range("A" & 2 + i).Value).Visible = False
End If
Next i
End If
End Sub
This is fireing only when the values in the range B4:B32 on the sheet are changed...
Hope this helps...