I am looking to hide all rows (until row 150), that contain a certain text in a certain column. The column contains a drop down of two choices, "Yes" and "No". If the answer is yes, I want to hide all the rows below, if it is no, then not hide.
ie, C2 is "No", don't hide. C3 is "Yes", hide...There are 150 rows of Yes or no, but once yes, you can hide all the rows.
I've tried to cycle the code below and it works with the first cell, but all rows after that do not work
Option Explicit
Private Sub HideRows(ByVal Target As Range)
If Range("C2").Value = "Yes - provide details" Then
Rows("3:150").EntireRow.Hidden = True
ElseIf Range("C2").Value = "No" Then
Rows("3:150").EntireRow.Hidden = False
End If
If Range("C3").Value = "Yes - provide details" Then
Rows("4:150").EntireRow.Hidden = True
ElseIf Range("C3").Value = "No" Then
Rows("4:150").EntireRow.Hidden = False
End If
' all the way through to C149
If Range("C149").Value = "Yes - provide details" Then
Rows("150").EntireRow.Hidden = True
ElseIf Range("C149").Value = "No" Then
Rows("150").EntireRow.Hidden = False
End If
End Sub
I expected to be able to cycle through the first If code, but it doesn't work after the 1st set of them
(this is untested)
Rows("3:150").EntireRow.Hidden = False
For i = 2 to 150
If Range("C" & i).Value = "Yes - provide details" Then
Rows(i + 1 & ":150").EntireRow.Hidden = True
Exit For
End If
Next i
Since it looks like you don’t want to filter because you want all rows below a “yes” to be hidden. I would recommend doing a loop.
Option Explicit
Sub HideRows()
Dim currRow as Integer: currRow = 1
Dim continue as Boolean: continue = True
While continue
If cells(currRow,3) = "Yes - provide details" then
rows(currRow & ":150").EntireRow.Hidden = true
continue = False
Else
currRow = currRow + 1
End If
Wend
End Sub
This is untested from mobile.
Related
Using VBA in excel, trying to understand how I can use a checkbox to hide/unhide any row that has a specific value in a specific column. My VBA skills are getting better more I practice but I am still not good with loops just yet. Appreciate any help you can provide. Here is what I have so far.
Private Sub CkBx_ShowAllRecords_Click()
If Me.CkBx_ShowAllRecords = True Then
For Each Row In Range("Table1").ListObject.ListColumns
If Row.Cells(1, "column5").Value = "Submission Complete" Then
Application.EntireRow.Visible=True
Next
End if
End Sub
Additionally when I uncheck the box I would want all rows where column 5 cell value equals "submission complete" would be hidden (just the opposite of what I put above when I check the box control).
Hope this may help you:
Private Sub CkBx_ShowAllRecords_Click()
Dim i As Long
If Me.CkBx_ShowAllRecords = True Then
For i = 1 To ActiveSheet.ListObjects("Table1").Range.Rows.Count
If ActiveSheet.ListObjects("Table1").DataBodyRange(i, 5).Value = "Submission Complete" Then
Rows((i + 1) & ":" & (i + 1)).Select
Selection.EntireRow.Hidden = True
End If
Next i
Else
ActiveSheet.Rows.EntireRow.Hidden = False
End If
Me.Hide
End Sub
In my data sheet, I want to allow users to hide whichever columns they want, but column F cannot be hidden. When the user wants to hide a column, they push a button which brings up an input form, and they can enter the column(s) they want to hide. I have it working if column F is specifically mentioned(i.e. user inputs "F" or "A,C,F,G" etc), but I'm not sure how to go about if they enter it as a range and F isn't specified (i.e. A-G, E-I, etc.). Here's the code that I have:
If Len(TheColumn) <= 2 Then
If Hide = True And TheColumn = "F" Then
MsgBox "Sorry, you cannot hide column F", vbOKOnly, "Action cancelled!"
Exit Sub
End If
Else
If InStr(1, TheColumn, ",F,") > 0 Or InStr(1, TheColumn, ",F") > 0 Or Left(TheColumn, 1) = "F" Then
MsgBox "Sorry, you cannot hide column F", vbOKOnly, "Action cancelled!"
Exit Sub
End If
End If
I thought about using ASC to find out if ASC("F") is between the ASC of the first and last letters, but it only counts the first character, so ASC("AA") is the same as ASC("A"), which could cause issues if you want to hide "Z-AB"
Also just realized my code below won't work if they enter a range that doesn't encompass F (i.e A-D) anyway.
sStart = 1
Do Until sStart > Len(TheColumn)
sEnd = InStr(sStart, TheColumn, ",") - 1
If sEnd = -1 Then sEnd = Len(TheColumn)
col = Mid(TheColumn, sStart, sEnd - sStart + 1)
If Show = True Then
Range(col & "1").EntireColumn.Hidden = False
Else
Range(col & "1").EntireColumn.Hidden = True
End If
sStart = sEnd + 2
Loop
You can use regular expression to make it usable for Range to hide columns in one line instead of using loops. At the end of code you just make sure that column F is always visible.
Sub F()
Dim cols, re
Set re = CreateObject("VBScript.RegExp")
re.Global = True: re.Pattern = "([A-Z]{1,2})(?=,|$)"
cols = "A,C,E,F": cols = re.Replace(cols, "$1:$1") '=> A:A,C:C,E:E,F:F
Range(cols).EntireColumn.Hidden = True
Columns("F").Hidden = False
End Sub
Hey I have been writing some code to add a part ID to a spreadsheet off of a user form in Excel VBA. I have been reading through different documentation and can not figure out why no matter what type of method of inserting a row I try it inserts a row with a repeating value instead of a blank one. If anyone knows how to specify blank, other than writing the whole row to blank and then writing my numbers I want after, that would be appreciated.
I have tried both the following lines to add a row
Cells (x+1 ,column).EntireRow.Insert Shift:= xlDown
ws1.Rows(x+1).Insert Shift:=xlDown
This is the function it is used in:
Public Sub Add(IDRange As Range)
SearchCell = Cells(x, IDRange.Column)
Cells(x, IDRange.Column).Select
Do
If SearchCell = PartID Then
MsgBox " this Company Already uses this part"
Exit Sub
ElseIf x <> StopRow Then
x = x + 1
SearchCell = Cells(x, IDRange.Column)
End If
Loop While x <> StopRow And SearchCell <> PartID
Cells(x + 1, IDRange.Column).EntireRow.Insert Shift:=xlDown
Cells(x, IDRange.Column).Value = PartID
MsgBox PartID & " has been added to Adress " & Cells(x, IDRange.Column).Address
Cells(x, IDRange.Column).Select
End Sub
Bellow is the function that calls the Add Function and where I belive it may be getting the company name from
Private Sub AddPart_Click()
AddPartCounter = 0
Company = UserForm1.CompanyBox.Value
PartID = UserForm1.PartBox.Value
If Company = "" Then
MsgBox " Please put in the company you would like the part to go under"
ElseIf PartID = "" Then
MsgBox " Please put in the Part you would like entered"
ElseIf UserForm1.Studs.Value = False And UserForm1.Spreaders.Value = False And UserForm1.Blocks.Value = False And UserForm1.Imma.Value = False Then
MsgBox "Please select the type of part you are trying to add"
Else
Dim CurrentCell
Set CurrentCell = Cells.Find(What:=Company, LookAt:=xlWhole)
If CurrentCell Is Nothing Then
MsgBox " Company Not Found "
Exit Sub
End If
x = CurrentCell.Row
Do
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop While CurrentCell.Offset(1, 0) = "" And Not CurrentCell Is Nothing And CurrentCell.Offset(1, 0).Row <> thisvar.Row + 1
StopRow = CurrentCell.Row
'If they are trying to add a nut
If UserForm1.Imma.Value = True Then
Call Add(Nut_ID_Rng)
'IF they are trying to add a stud
ElseIf UserForm1.Studs.Value = True Then
Call Add(Stud_ID_Rng)
'If they are trying to add a block
ElseIf UserForm1.Blocks.Value = True Then
Call Add(Block_ID_Rng)
'If they are trying to add a spreader
ElseIf UserForm1.Spreaders.Value = True Then
Call Add(Spreader_ID_Rng)
End If
End If
AddPartCounter = 1
End Sub
I know that the repeating pattern is coming from the insert line through debugging but I can not figure out why I have tried changing variables to numbers and it still did the same thing. This what it looks like with the repeating values.
enter image description here
The problem is that you most likely have a value still stored in your clipboard when you execute the Macro. To fix that, simply add this line of dode before running the insert line:
Applcation.CutCopyMode = False
That will clear your clipboard and allow the inserted rows to be blank.
I have 80 rows where the user can enter a predetermined value under column Ward. This unhides a button next to it. Upon clicking it, it empties the adjacent value and increments (+1) a particular cell in another sheet depending on the original value.
Currently, I have 80 ActiveX buttons next to the Ward cells that hides/unhides depending on the value of the Ward cells. I've noticed that adding more buttons slows down the spreadsheet because of the sheer volume of If Then statements I have.
If Range("F8").Value = 0 Then
Sheets("Admissions").EDAdmit1.Visible = False
Else
Sheets("Admissions").EDAdmit1.Visible = True
End If
If Range("L8").Value = 0 Then
Sheets("Admissions").ElecAdmit1.Visible = False
Else
Sheets("Admissions").ElecAdmit1.Visible = True
End If
If Range("F9").Value = 0 Then
Sheets("Admissions").EDAdmit2.Visible = False
Else
Sheets("Admissions").EDAdmit2.Visible = True
End If
If Range("L9").Value = 0 Then
Sheets("Admissions").ElecAdmit2.Visible = False
Else
Sheets("Admissions").ElecAdmit2.Visible = True
End If
.. and so on.
Not to mention the If Then statements I have for every button click.
Private Sub EDAdmit1_Click()
If Range("F8") = "ICU" Then
Worksheets("Overview").Range("AD11").Value = Worksheets("Overview").Range("AD11") + 1
ElseIf Range("F8") = "HDU" Then
Worksheets("Overview").Range("AF11").Value = Worksheets("Overview").Range("AF11") + 1
ElseIf Range("F8") = "DPU" Or Range("F8") = "Other" Then
Else
Col = WorksheetFunction.VLookup(Range("F8"), Range("U1:V27"), 2)
Worksheets("Overview").Range(Col).Value = Worksheets("Overview").Range(Col).Value + 1
End If
Range("F8").ClearContents
End Sub
Is there a more efficient way of doing this?
Admission List:
You could consider using "admit" hyperlinks in the cells next to the Ward selections: that way you only need one handler (Worksheet_FollowHyperlink in the worksheet module). Note you need to use Insert >> Hyperlink and not the HYPERLINK() formula-type links here (because formula-based links don't trigger the FollowHyperlink event).
You can ditch the hide/show code and instead use conditional formatting to change the link font color to hide the links when there's no Ward selected. If a user clicks on one of the hidden links then you can just do nothing.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim rngSrc As Range, addr, ward
Set rngSrc = Target.Range '<< the cell with the link
ward = rngSrc.Offset(0, 1).Value '<< cell with Ward
'only do anything if a ward is selected
If Len(ward) > 0 Then
'find the cell to update
Select Case ward
Case "ICU"
addr = "AD11"
Case "HDU"
addr = "AF11"
Case "DPU", "Other"
addr = ""
Case Else
addr = Application.VLookup(ward, Me.Range("U1:V27"), 2, False)
End Select
'if we have a cell to update then
If Len(addr) > 0 Then
With Worksheets("Overview").Range(addr)
.Value = .Value + 1
End With
End If
rngSrc.Offset(0, 1).ClearContents
End If
rngSrc.Select '<< select the clicked-on link cell
' (in case the link points elsewhere)
End Sub
At the beginning of your code put this line:
Application.ScreenUpdating = False
this will disable all screen updates. Let your code do changes, and then enable screen updating, and all your changes will appear.
Application.ScreenUpdating = True
Disabling screen updating usually makes the execution of code faster.
I’m trying, with Excel 2013, to hide and unhide rows when a cell is a certain value.
It's a form which should expand based on answers given.
When C16 = YES hide rows 18:22
When C16 = NO hide rows 24:38
When C16 =blank hide rows 18:38
When L43 = YES unhide rows 43:68 (if it’s not yes a zero is displayed)
I have tried 2 methods.
First: Into the worksheet - selected change in the top right dropdown
Private Sub Worksheet_Change(ByVal Target As Range)
Range("A18:A22").EntireRow.Hidden = (Range("$C$16").Value = "Yes")
Range("A24:A38").EntireRow.Hidden = (Range("$C$16").Value = "NO")
Range("A18:A38").EntireRow.Hidden = (Range("$C$16").Value = "")
Range("A43:A68").EntireRow.Hidden = (Range("$L$43").Value = "0")
End Sub
Second: code from here:
Unhide rows based on cell value
Using both of these methods only one of the changes seems to go ahead. So cell C16 is changed but that means range L43 is ignored
Also when the cell was blank it didn’t change anything. It remained as is and didn’t hide the columns as required.
Your ranges overlap so even if C16 = "Yes" the line C16 = "" will override it and unhide it. L42 is probably also a number where as you're comparing it to a text value try using the following instead. Your code would run on every single change in your sheet as well so have also updated it to only run when either C16 or L43 is changed
Private Sub Worksheet_Change(ByVal Target As Range)
With Me
If Not Intersect(Target, Union(.Range("C16"), .Range("L43"))) Is Nothing Then
.Range("A18:A38").EntireRow.Hidden = False
Select Case LCase(.Range("C16").Value2)
Case "yes"
.Range("A18:A22").EntireRow.Hidden = True
Case "no"
.Range("A24:A38").EntireRow.Hidden = True
Case Else
.Range("A18:A38").EntireRow.Hidden = True
End Select
.Range("A43:A68").EntireRow.Hidden = False
Select Case LCase(.Range("L43").Value2)
Case "yes"
.Range("A43:A68").EntireRow.Hidden = False
Case Else
.Range("A43:A68").EntireRow.Hidden = True
End Select
End If
End With
End Sub
After comments
I'd break this into two from your comments. The first would watch the dropdown and execute on the change of that cell. The second would update using the calculate event. Put these Subs in the sheets where applicable
Private Sub Worksheet_Change(ByVal Target As Range)
With Me
If Not Intersect(Target, Union(.Range("C16"), .Range("L43"))) Is Nothing Then
.Range("A18:A38").EntireRow.Hidden = False
Select Case LCase(.Range("C16").Value2)
Case "yes"
.Range("A18:A22").EntireRow.Hidden = True
Case "no"
.Range("A24:A38").EntireRow.Hidden = True
Case Else
.Range("A18:A38").EntireRow.Hidden = True
End Select
End If
End With
End Sub
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
With Me
.Range("A43:A68").EntireRow.Hidden = False
Select Case LCase(.Range("L43").Value2)
Case "yes"
.Range("A43:A68").EntireRow.Hidden = False
Case Else
.Range("A43:A68").EntireRow.Hidden = True
End Select
End With
Application.EnableEvents = True
End Sub
Try:
With Worksheets("Sheet1")
.Rows("18:68").EntireRow.Hidden = False
opt = UCase(.Range("C16").Value)
Select Case opt
Case "YES"
Rows("18:22").EntireRow.Hidden = True
Case "NO"
Rows("24:38").EntireRow.Hidden = True
Case ""
Rows("18:38").EntireRow.Hidden = True
Case Else
MsgBox "Invalid option in cell C16."
End Select
If UCase(.Range("L43").Value) = "Yes" Then
Rows("43:68").EntireRow.Hidden = True
Else
MsgBox "Invalid option in cell L43."
End Select
End With
...though I didn't understand what you wanted to be '0'.