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
Related
I have created a simple Excel Macro which is triggered when a user clicks on a cell in a worksheet (worksheet1). Basically the macro takes the value of the cell which was clicked on and selects a target cell in a separate worksheet (worksheet2) that has the same value.
The problem is that about 20% of the time after being directed to worksheet2, the target cell is highlighted but is just out of view, i have to scroll down a couple of rows to see it. I want to be able to ensure that the target cell is always in view after the user is directed to it, but I am not sure how this can be achieved.
This is in Excel 2016.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then
If Target.Cells.Count = 1 Then
Application.ScreenUpdating = False
Dim c As Range
Dim ans As String
Dim Lastrow As Long
ans = ActiveCell.Value
Lastrow = Sheets("worksheet2").Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Sheets("worksheet2").Range("A2:A" & Lastrow)
If c.Value = ans Then Application.Goto Reference:=Sheets("worksheet2").Range(c.Address): Exit Sub
Next
End If
End If
Exit Sub
End Sub
You can use find to find the selected item in sheet2 then just select the sheet and the found cell
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As Range
If Target.Column = 1 Then
Set s = Worksheets("Sheet2").Range("B:B").Find(what:=Target, lookat:=xlWhole)
If Not s Is Nothing Then
Worksheets("Sheet2").Activate
s.Select
Else: MsgBox Target.Value & " is not found in sheet 2"
End If
End If
End Sub
I have a list of names in a row, A2 to AAS2, I also have a drop-down list containing all of those names. I would like some VBA code that when the list is changed excel jumps to the cell matching the item in the list. Could someone please help me with this? Thank you.
The names are just text, no named ranges.
Here is what I have tried so far:
Private Sub FindTicker()
Dim MyVariable As String
MyVariable = Range("L1").Value
Application.Goto Reference:=Range(MyVariable)
End Sub
And Also
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> [L1].Address Then
Exit Sub
Else
JumpToCell
End If
End Sub
Sub JumpToCell()
Dim xRg, yRg As Range
Dim strAddress As String
strAddress = ""
Set yRg = Range("A2:AAS2")
For Each xRg In yRg
'MsgBox Cell.Value
If xRg.Value = ActiveCell.Value Then
strAddress = xRg.Address
End If
Next
If strAddress = "" Then
MsgBox "The Day You Selected in Cell D4 Was Not Found On " & ActiveSheet.Name, _
vbInformation, "Ticker Finder"
Exit Sub
Else
Range(strAddress).Offset(0, 1).Select
End If
End Sub
When I tried using both of these when I changed the drop-down list nothing happened. No errors or anything.
Lots of ways to do this and with some tweaks your code above could work but its a bit inefficient and more complicated than it needs to be. The simplest way would be to use the Find method of the Range class to locate the cell:
Lets say your drop-down list of names is in cell A1 on sheet MySheet and the long list is in column C. Use the Find method to set a range variable to equal the first cell containing the item in cell A1.
Dim rng As Range
Dim ws As Worksheet
Set ws = Sheets("MySheet")
Set rng = ws.Range("C:C").Cells.Find(ws.Range("A1"), lookat:=xlWhole)
If Not rng Is Nothing Then ' the item was found
rng.Select
Else
MsgBox "This item is not in the list", vbInformation
End If
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
I am new in VBA and I want to write a program that when I manually select 1 or more items from a list the code searches with the name of the item and picks it from another sheet, copies the whole row and pastes it in a 3rd sheet. Is that possible? Preferably with a click of a button the selection is made. Thanks a lot!
Here is an example.
Sub FindAndMove()
Dim Finder As Range
Dim TheItem As Variant
With Sheets("Sheet1")
If Selection.CountLarge = 1 And Not Intersect(Selection, .Range("A2:A11")) Is Nothing Then
TheItem = Selection.Value
Else
MsgBox ("Please select an item from the list")
Exit Sub
End If
End With
With Sheets("Sheet2")
Set Finder = .Range("A:A").Find(TheItem, LookAt:=xlWhole)
If Finder Is Nothing Then
MsgBox ("Item not found!")
Exit Sub
End If
With Sheets("Sheet3")
Finder.EntireRow.Copy .Range("A" & .UsedRange.Rows.CountLarge + 1)
.Select 'Optional - show sheet 3
End With
End With
End Sub
Walking through the code:
When they click the button, if they only select 1 cell that's in our list.
Get the value of the item they selected
On Sheet2 - go find that value in column A
If you find it, copy the entire row to the end of Sheet3
You can modify the code by changing the sheet names in Sheet("Sheet1") to whatever you want.
You can also change the list range by changing .Range("A2:A11")
You can change the range to search by changing .Range("A:A")
Sheet 1:
Sheet 2:
Sheet 3: (after we select item 3 and click Find and Move)
Error Handling:
Edit:
Code to find multiple occurrences using FindNext
Sub FindAndMove()
Dim Finder As Range
Dim FirstAddress As Variant
Dim TheItem As Variant
With Sheets("Sheet1")
If Selection.CountLarge = 1 And Not Intersect(Selection, .Range("A2:A11")) Is Nothing Then
TheItem = Selection.Value
Else
MsgBox ("Please select an item from the list")
Exit Sub
End If
End With
With Sheets("Sheet2")
Set Finder = .Range("A:A").Find(TheItem, LookAt:=xlWhole)
If Finder Is Nothing Then
MsgBox ("Item not found!")
Exit Sub
End If
FirstAddress = Finder.Address
Do
With Sheets("Sheet3")
Finder.EntireRow.Copy .Range("A" & .UsedRange.Rows.CountLarge + 1)
End With
Set Finder = .Range("A:A").FindNext(Finder)
Loop While Not Finder Is Nothing And Finder.Address <> FirstAddress
End With
Sheets("Sheet3").Select 'Optional - Select Sheet3 After.
End Sub
I'm creating an excel file with column A to H are mandatory cells.
This excel file will be passing around for input.
So, I would like to highlight the empty cells as a reminder.
I have written the following code...
Sub Highlight_Cell()
Dim Rng As Range
For Each Rng In Range("A2:H20")
If Rng.Value = "" Then
Rng.Interior.ColorIndex = 6 ‘yellow
Else
Rng.Interior.ColorIndex = 0 'blank
End If
Next Rng
MsgBox "Please fill in all mandatory fields highlighted in yellow."
End Sub
However, I would like to set the range from A2 to the last row that contains data within column A to H.
Also, display the message box only when empty cell exist.
Could you please advise how should I amend?
Million Thanks!!!
This is a VBA solution that prevents the user from saving until the desired range is filled (acknowledging Gserg's comment that that the last row is one that has at least one cell entered)
In the second portion you can either add your sheet index directly, Set ws = Sheets(x) for position x, or Set ws = Sheets("YourSheet") for a specific sheet name
The code will only highlight truly blank cells within A to H of this sheet till the last entered cell (using SpecialCells as a shortcut). Any such cells will be selected by the code on exit
Put this code in the ThisWorkbook module (so it fires whenever the user tries to close the file)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
bCheck = False
Call CheckCode
If bCheck Then Cancel = True
End Sub
Put this code in a standard module
Public bCheck As Boolean
Sub CheckCode()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
bCheck = False
'works on sheet 1, change as needed
Set ws = Sheets(1)
Set rng1 = ws.Columns("A:H").Find("*", ws.[a1], xlValues, xlWhole, xlByRows)
If rng1 Is Nothing Then
MsgBox "No Cells in columns A:H on " & ws.Name & " file will now close", vbCritical
Exit Sub
End If
Set rng2 = ws.Range(ws.[a1], ws.Cells(rng1.Row, "H"))
On Error Resume Next
Set rng2 = rng2.SpecialCells(xlBlanks)
On Error GoTo 0
If rng2 Is Nothing Then Exit Sub
bCheck = True
rng2.Interior.Color = vbYellow
MsgBox "Please fill in all mandatory fields on " & ws.Name & " highlighted in yellow", vbCritical, "Save Cancelled!"
Application.Goto rng2.Cells(1)
End Sub