I am looking to write a code about hiding or un-hiding worksheets in Excel depending the value of a cell.
I have reached to this
Sub Hide_Un()
If Range("b4").Value = "yes" Then
sheets(2).Visible = True
ElseIf Range("b4").Value = "no" Then
sheets(2).Visible = False
End If
If Range("b5").Value = "yes" Then
sheets(3).Visible = True
ElseIf Range("b5").Value = "no" Then
sheets(3).Visible = False
End If
There are about 100 sheets and I can't do this procedure every time I add a new sheet.
I need a code to hide or unhide each worksheet depending my declaration to a cell.
Example B1="yes" (visible) or B1="no" (not visible)
Option Compare Text makes this non case sensitive. This way YES = yes. Without this Option, they would not be equal
You may need to account for the option of the value being neither yes or no. What if value is y or n or yes with a lagging space?
Using the sheet index number (Sheet(n)) can be problematic if users have the option to add/move/delete sheets in the book.
It looks like the row number relates to sheet number by Sheet # = Row -2. I am starting the loop at 4. The lowest this could be is 3 - other wise you will end up trying to hide a sheet that cannot exist
Option Explicit
Option Compare Text
Sub Hide_Un()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("TOC")
Dim i
Application.ScreenUpdating = False
For i = 4 To ws.Range("B" & ws.Rows.Count).End(xlUp).Row
If ws.Range("B" & i) = "yes" Then
ThisWorkbook.Sheets(i - 2).Visible = xlSheetVisible
ElseIf ws.Range("B" & i) = "no" Then
ThisWorkbook.Sheets(i - 2).Visible = xlSheetHidden
Else 'What if the cell is neither?
'Do what you want if the cell is not "yes" or "no"
End If
Next i
Application.ScreenUpdating = True
End Sub
Put this code into the ThisWorkbook code sheet.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case LCase(Sh.Name)
Case "toc"
If Not Intersect(Target, Sh.Range("B:B")) Is Nothing Then
Dim t As Range
For Each t In Intersect(Target, Sh.Range("B:B"))
If t.Row > 3 Then
Worksheets(t.Row - 2).Visible = _
CBool(LCase(t.Value) = "yes")
End If
Next t
End If
Case Else
'do nothing
End Select
End Sub
Related
I am following up on an answer that has been posted before at the following link: Circular Reference with drop-down list
The answer works when the dropdown lists and sources are on the same cell on their respective sheets, but I am trying to find out how this work if the lists and source are not on the same cell. Thank you
I am following this answer:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$B$5" And Sh.Name <> "Sheet3" Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim w As Long
For w = 1 To Worksheets.Count
With Worksheets(w)
'skip this worksheet and Sheet3
If CBool(UBound(Filter(Array(Sh.Name, "Sheet3"), _
.Name, False, vbTextCompare))) Then
.Range("B5") = Target.Value
'.Range("B5").Interior.ColorIndex = 3 '<~~testing purposes
End If
End With
Next w
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I am trying to have two lists where I can change one and it'll update the other. How do I create the same result in the dropdown for example on cell A3 on Sheet1 and D9 on Sheet2?
Here is what I am after: I want to generate on two sheets (sheet 1, sheet 2) a drop-down list that says either "Complete" or "Incomplete." If I change sheet 1 from Complete to Incomplete, I want sheet 2 to say the same thing, but I also want vice versa
(If I change sheet 2 from Complete to Incomplete, I want sheet 1 to change).
Try like this:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim arrCells, el, i As Long, m, tgt, arr
arrCells = Array("Sheet1|D3", "Sheet2|B4") 'all cells with the list
tgt = Sh.Name & "|" & Target.Address(False, False)
m = Application.Match(tgt, arrCells, 0) 'matches one of the list cells?
If Not IsError(m) Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For i = LBound(arrCells) To UBound(arrCells)
If arrCells(i) <> tgt Then 'skip the cell raising the event...
arr = Split(arrCells(i), "|")
ThisWorkbook.Sheets(arr(0)).Range(arr(1)).Value = Target.Value
End If
Next i
Application.EnableEvents = False
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I'm putting together a spreadsheet that should populate checkboxes in a specific column when the spreadsheet opens if the appropriate A Column/Row is not empty. It should also remove checkboxes when it finds that same A column to be empty. My VB is correctly creating the checkboxes, but I cannot figure out how to tell the code to delete the checkbox from a specific cell.
Most articles I find mention removed ALL checkboxes, but I'm looking to do it conditionally. Any guidance would be greatly appreciated.
Private Sub Workbook_Open()
'declare a variable
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'calculate if a cell is not blank across a range of cells with a For Loop
For x = 2 To 1000
If ws.Cells(x, 1) <> "" Then
Call Add_CheckBox(CInt(x))
Else
Call Delete_CheckBox(CInt(x))
End If
Next x
End Sub
Private Sub Add_CheckBox(Row As Integer)
ActiveSheet.CheckBoxes.Add(Cells(Row, "T").Left, Cells(Row, "T").Top, 72, 12.75).Select
With Selection
.Caption = ""
.Value = xlOff '
.LinkedCell = "AA" & Row
.Display3DShading = False
End With
End Sub
Private Sub Delete_CheckBox(Row As Integer)
Dim cb As CheckBox
If cb.TopLeftCell.Address = (Row, "T") Then cb.Delete
End Sub
Naming the CheckBoxes will make it easier to maintain your code.
Private Sub Workbook_Open()
Const CheckBoxPrefix As String = "Sheet1TColumnCheckBox"
'declare a variable
Dim CheckBoxName As String
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'calculate if a cell is not blank across a range of cells with a For Loop
Dim r As Long
For r = 2 To 1000
CheckBoxName = CheckBoxPrefix & r
If Len(ws.Cells(r, 1)) > 0 Then
If Not WorksheetContainsCheckBox(CheckBoxName, ws) Then Add_CheckBox CheckBoxName, ws.Cells(r, 1), ws.Cells(r, "AA")
Else
If WorksheetContainsCheckBox(CheckBoxName, ws) Then ws.CheckBoxes(CheckBoxName).Delete
End If
Next
End Sub
Private Sub Add_CheckBox(CheckBoxName As String, Cell As Range, LinkedCell As Range)
With Cell.Worksheet.CheckBoxes.Add(Cell.Left, Cell.Top, 72, 12.75)
.Caption = ""
.Value = xlOff '
.LinkedCell = LinkedCell
.Display3DShading = False
.Name = CheckBoxName
End With
End Sub
Function WorksheetContainsCheckBox(CheckBoxName As String, ws As Worksheet)
Dim CheckBox As Object
On Error Resume Next
Set CheckBox = ws.CheckBoxes(CheckBoxName)
WorksheetContainsCheckBox = Err.Number = 0
On Error GoTo 0
End Function
Try something like this (put a checkbox "in" A1 but not C1)
Sub tester()
Debug.Print Delete_CheckBox([A1])
Debug.Print Delete_CheckBox([C1])
End Sub
'Return True if able to delete a checkbox from range `rng`
Private Function Delete_CheckBox(rng As Range) As Boolean
Dim cb As CheckBox
For Each cb In rng.Worksheet.CheckBoxes
If Not Application.Intersect(cb.TopLeftCell, rng) Is Nothing Then
Debug.Print "Deleting checkbox in " & cb.TopLeftCell.Address
cb.Delete
Delete_CheckBox = True
Exit For 'if only expecting one matched checkbox
End If
Next cb
End Function
I have a userform with a combobox on a sheet "PostHistory" that draws it's data from the "Staff" sheet. When you press Add on the userform it's suppose to locate the name on the Staff Sheet and replace the date next to the name. Occasionally, it will replace the date and the date next to the name below it. Using Excel 2016
Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
Sheets("Staff").Visible = True
Sheets("Engine").Visible = True
Dim TargetRow As Integer
Dim nameRange As Range
Set nameRange = Sheets("Staff").Range("C3:C200")
TargetRow = Sheets("Engine").Range("D3").Value
Sheets("PostHistory").Range("B3").EntireRow.Insert Shift:=xlDown
Sheets("PostHistory").Range("B3").Value = txt_date
Sheets("PostHistory").Range("C3").Value = cb_staff
Sheets("PostHistory").Range("D3").Value = txt_post
Sheets("PostHistory").Range("E3").Value = txt_notes
If (Augment.txt_date.Text) = "" Then
GoTo Skip1
ElseIf IsNull(Augment.txt_date.Value) = False Then
End If
For Each cell In nameRange.Cells
If cell.Text = [cb_staff] Then
cell.Offset(0, -1).Value = txt_date
End If
Next
Skip1:
Unload Augment
Sheets("Staff").Visible = False
Sheets("Engine").Visible = False
Sheets("List").Visible = False
Application.ScreenUpdating = True
Augment.Show
End Sub
To start: I didn't find the reason why your code should write more than once. But I believe the code below will not write anything twice.
Private Sub CommandButton7_Click()
' 209
Dim nameRange As Range
Dim Fnd As Range
Dim Ctls() As String
Dim i As Integer
Ctls = Split("txt_Date,cb_Staff,txt_Post,txt_Notes", ",")
If Len(txt_Date) Then
With Worksheets("Staff")
Set nameRange = .Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp))
End With
Set Fnd = nameRange.Find(cb_Staff.Value, , xlValues, xlWhole)
If Not Fnd Is Nothing Then Fnd.Offset(0, -1).Value = txt_Date.Value
End If
With Worksheets("PostHistory")
.Rows(3).EntireRow.Insert Shift:=xlDown
With .Rows(3)
For i = 0 To UBound(Ctls)
.Cells(3 + i).Value = Me.Controls(Ctls(i)).Value
Me.Controls(Ctls(i)).Value = ""
Next i
End With
End With
End Sub
In principle, you don't need to unhide a sheet in order to read from or write to it. Also, if the sheet to which you write is hidden, there is no point in stopping ScreenUpdating. Finally, I did like the way you found to clear all controls but believe that it will interfere with your management of the list in the combo box. Therefore I showed you another method above.
Oh, yes. I created a userform called Augment with one combo box, 3 text boxes and one CommandButton7. I hope that is what you also have.
I have a master sheet (Sheet 1) that contains 50+ rows of specific items. I have a sheet corresponding to each item and named as such (ie. item 1 = "Clearing" so sheet 2 is named "Clearing"). I have a drop down menu for each item in Column D that displays "Yes" or "No".
I currently have a basic code that hides Sheets based on if my "Column D" drop down menus for 50+ rows = "No" (ie. Item 1 marked as "No" so sheet 2 is hidden).
Private Sub Worksheet_Change(ByVal Target As Range)
If [D2] = "Yes" Then
Sheets("Clearing").Visible = True
Else
Sheets("Clearing").Visible = False
End If
If [D3] = "Yes" Then
Sheets("Grubbing").Visible = True
Else
Sheets("Grubbing").Visible = False
End If
End Sub
I want to be able to run this in a loop for all 50+ items by using a range of cells D2:D50+ without having to enter in each sheet name as I've done above. I haven't been able to figure out how to manage this by looking at other's examples.
Any help is much appreciated.
Using the Worksheet_Change event you started out with:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range(Range("D2"), Range("D2").End(xlDown))
If Not Intersect(Target, rng) Is Nothing Then
If Target.Count = 1 Then
On Error GoTo ErrorHandler
If Target = "Yes" Then
Sheets(Target.Offset(, -1).Value).Visible = True
Else
Sheets(Target.Offset(, -1).Value).Visible = False
End If
End If
End If
Exit Sub
ErrorHandler:
MsgBox "The sheet '" & Target.Offset(, -1) & "' does not exist!"
End Sub
If your data is set up with the sheet name next to column D (or anywhere really, just adjust the script), you can just loop through.
Sub hide_Sheets()
Dim mainWS As Worksheet
Dim rng As Range
Set mainWS = ThisWorkbook.Sheets("Sheet1")
Set rng = mainWS.Range("C2:C5") ' Change range as needed
Dim cel As Range
For Each cel In rng
If cel.Offset(0, 1).Value = "Yes" Then
ThisWorkbook.Sheets(cel.Value).Visible = True
Else
ThisWorkbook.Sheets(cel.Value).Visible = False
End If
Next cel
End Sub
I wonder whether someone may be able to help me please.
I'm using the code below, which among a number of actions being performed, automatically populates column "A" with the date, and column "AS" with the text value "No" when a new record is created within a Excel spreadsheet.
Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range, res As Variant
Dim rCell As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Application.EnableCancelKey = xlDisabled
'Sheets("Input").Protect "handsoff", UserInterFaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
If Target.Column = 3 Then
If Target = "No" Then MsgBox "Please remember to make the same change to all rows for " & Target.Offset(0, -1).Value & " and delete any future forecasts"
End If
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
With Rows(Target.Row)
.Range("A1").Value = Date
.Range("AS1").Value = "No"
End With
Application.EnableEvents = True
Target.Interior.ColorIndex = 35
End If
End If
On Error GoTo 0
If Target.Column = 45 Then
If Target.Value = "Yes" Then
Set Rng1 = Application.Union(Cells(Target.Row, "B").Resize(, 19), Cells(Target.Row, "R"))
Rng1.Interior.ColorIndex = xlNone
Set Rng2 = Application.Union(Cells(Target.Row, "S").Resize(, 12), Cells(Target.Row, "AD"))
Rng2.Interior.ColorIndex = 37
Set Rng3 = Application.Union(Cells(Target.Row, "AF").Resize(, 12), Cells(Target.Row, "AQ"))
Rng3.Interior.ColorIndex = 42
End If
End If
If Not Intersect(Target, Range("J7:J400")) Is Nothing Then
Set Cell = Worksheets("Lists").Range("B2:C23")
res = Application.VLookup(Target, Cell, 2, False)
If IsError(res) Then
Range("K" & Target.Row).Value = ""
Else
Range("K" & Target.Row).Value = res
End If
End If
End Sub
What I'd like to do, if at all possible, is when the date is inserted into column "A", I'd like to insert the text value "Select" on the same row in column "C". This value is taken from the first value I have in a drop down menu, set up on a sheet called "Lists" with the named range "RDStaff".
Could someone perhaps tell me please how I may go about changing the functionality, so that as soon as column "A" is populated with the date, the first value from my list i.e. "Select" is automatically populated in column "C"?
Many thanks and kind regards
Chris
It is not clear exactly which cell in column C is where your validation list is being used from, but if you add the code below into your with statement it should work, of course, adjusting to the appropriate drop-down cell.
.Range("C1").Value = Sheets(1).Range("C10").Value
Now, this assumes your drop down list, based on your validation is in the first sheet of your workbook (by index) in cell C10. You'll need to adjust these to match your data / workbook structure.
The point is that you don't hard code the value. You reference the value from the drop-down list location.
Per your comments, here is a code snippet to add the validation list into your code.
With Rows(Target.Row)
'... your existing code
With Range("C1").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Lists!RDStaff ' you may need to make this named range global for it to work on another sheet in this context
.IgnoreBlank = True
.InCellDropdown = True
End With
End WIth