I'm trying to write some VBA code that will unhide an entire row if another specific row is hidden. This macro also hides a range of rows based on the value in a specific column. This aspect works fine - I have reliable code. I can't get the first function I described to work. Should be easy to do, just don't know the syntax. This subroutine should execute upon opening the workbook.
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim targ As Range
Dim msg As Range
targ = "DETAILS!B6"
msg = "DETAILS!B42"
msg.EntireRow.Hidden = True
With Range("DETAILS!B6:B40")
.EntireRow.Hidden = False
For Each cell In Range("DETAILS!B6:B40")
Select Case cell.Value
Case Is = 0
cell.EntireRow.Hidden = True
End Select
Next cell
End With
If targ.EntireRow.Hidden = True Then
msg.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
You need to set the variables like below
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim targ As Range
Dim msg As Range
Set targ = "DETAILS!B6"
Set msg = "DETAILS!B42"
msg.EntireRow.Hidden = True
With Range("DETAILS!B6:B40")
.EntireRow.Hidden = False
For Each cell In Range("DETAILS!B6:B40")
Select Case cell.Value
Case Is = 0
cell.EntireRow.Hidden = True
End Select
Next cell
End With
If targ.EntireRow.Hidden = True Then
msg.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
Oh! Just put Set before targ and msg since they're a Range. When declaring ranges, you have to have Set, i.e. Set myRng = Range("A1:A10").
You might need to do Set targ = Range("Details!B6") if just Set Targ = "DetailsB6" doesn't work.
On second thought, I don't think Set Targ = "Details!B6" will work if you are Dim Targ as Range. You're dim'ing as a Range, but are declaring it as like a string. You need this to be a Range, to use it like targ.EntireRow.Hidden, etc.
Though you can call range objects like this : Range("DETAILS!B6:B40")
In vba it is better accepted to call it like this: Sheets("DETAILS").Range("B6:B40")
I fixed a few more syntax errors:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim targ As Range
Dim msg As Range
Set targ = Sheets("DETAILS").Range("B6")
Set msg = Sheets("DETAILS").Range("B42")
msg.EntireRow.Hidden = True
With Sheets("DETAILS").Range("B6:B40")
.EntireRow.Hidden = False
End With
For Each cell In Sheets("DETAILS").Range("B6:B40")
Select Case cell.Value
Case 0
cell.EntireRow.Hidden = True
End Select
Next cell
If targ.EntireRow.Hidden = True Then
msg.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
Related
Public Function highlight_text(Search)
Dim rng As Range
Dim cell As Range
Set rng = Range("A2:H32")
For Each cell In rng
If cell.text = Search Then
cell.Font.ColorIndex = 3
cell.Font.Name = "Arial"
cell.Font.Size = 14
cell.Font.Bold = True
Else
cell.Font.Bold = False
cell.Font.Size = 11
cell.Font.ColorIndex = 1
End If
Next cell
End Function
The above function is called on 'mouseover' a cell, it manages to set the proper cells to RED color but it won't make the text bold
You cannot call a function from the worksheet and change the format of a cell.
(The fact that even the color is changing is perplexing)
As this does not need to be a function, it does not return anything and you cannot use it from the worksheet, we can make it a sub:
Public Sub highlight_text(Search)
Dim rng As Range
Dim cell As Range
Set rng = Range("A2:H32")
For Each cell In rng
If cell.Text = Search Then
cell.Font.ColorIndex = 3
cell.Font.Name = "Arial"
cell.Font.Size = 14
cell.Font.Bold = True
Else
cell.Font.Bold = False
cell.Font.Size = 11
cell.Font.ColorIndex = 1
End If
Next cell
End Sub
Use a Worksheet_Change Event(or some other event) to call the sub:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A2:H32")) Is Nothing Then
highlight_text (Target.Text)
End If
End Sub
Put both of these in the worksheet code in which you want the code to run.
This will now highlight the like cells as you click on any cell in the range.
This is a good solution in this case. But I am confused by the statement that you cannot change to format of a cell in a function. Tried this to confirm. It works fine.
Function boldit() As String
Dim theCell As String
theCell = "Q8"
Range(theCell).Value = "XorY"
Range(theCell).Font.Color = RGB(255, 0, 0)
Range(theCell).Font.Bold = True
End Function
The reason I'm interested is that in a real function I have written the same .Font.Bold statement does not work (while the .Font.Color does)
Any other idea why .Font.Bold=True might not work
I keep getting this error, but can't figure out why. It looks like all rules are followed.
The structure as I read is the following - If -> ElseIf -> End If. But here I get an error though it's all the same.
Sub hide()
Application.ScreenUpdating = False
Dim wRange As Range
Set wRange = Range("A5:B10")
Dim mergedRows As Integer
Dim mergedColumns As Integer
Dim cellFirst As Range
For Each cell In wRange
If IsEmpty(cell) Then
cell.EntireRow.Hidden = True
ElseIf cell.MergeCells Then
mergeRows = cell.MergeArea.Rows.Count
mergeColumns = cell.MergeArea.Columns.Count
With cell.MergeArea
Set cellFirst = cell.MergeArea(Cells(1, 1))
If IsEmpty(cellFirst) Then
cellFirst.EntireRow.Hidden = True
End If
End If
Next
End Sub
You need to also close your With statement.
With cell.MergeArea
Set cellFirst = cell.MergeArea(Cells(1, 1))
If IsEmpty(cellFirst) Then
cellFirst.EntireRow.Hidden = True
End If
End With
Hi guys I made the code below to search for multiple text in a given column. The problem is that it is very slow. Do guys know any other ways to perform it faster?
For example give the array ('foo', 'bar'), The code should iterate on a column and match/filter only the rows that have both texts in any given order.
Sub aTest()
ScreenUpdating = False
Dim selectedRange As Range, cell As Range
Dim searchValues() As String
searchValues = Split(ActiveSheet.Cells(2, 1).Value)
Set selectedRange = Range("A4:A40000")
Dim element As Variant
For Each cell In selectedRange
If cell.Value = "" Then
Exit For
Else
For Each element In searchValues
If Not InStr(1, cell.Value, element) Then
cell.EntireRow.Hidden = True
End If
Next element
End If
Next cell
ScreenUpdating = True
End Sub
I was using it as a filter. copied and pasted the following code with a few modifications. But then I was not able to make the changes to match multiple strings.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iFilterColumn As Integer
Dim rFilter As Range
Dim sCriteria As String
On Error Resume Next
With Target
Set rFilter = .Parent.AutoFilter.Range
iFilterColumn = .Column + 1 - rFilter.Columns(1).Column
If Intersect(Target, Range("rCriteria")) Is Nothing Then GoTo Terminator
Select Case Left(.Value, 1)
Case ">", "<"
sCriteria = .Value
Case Else
sCriteria = "=*" & .Value & "*"
End Select
If sCriteria = "=" Then
.Parent.Range(rFilter.Address).AutoFilter Field:=iFilterColumn
Else
.Parent.Range(rFilter.Address).AutoFilter Field:=iFilterColumn, Criteria1:=sCriteria
End If
End With
Terminator:
Set rFilter = Nothing
On Error GoTo 0
End Sub
I'm assuming this:
Set selectedRange = Range("A4:A40000")
It's because the size is not defined properly, the following should limit to the right long
Set selectedRange = Range("A4:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If it doesn't affect, I always use these codes to speed up Excel (Instead of only ScreenUpdating alone).
Sub ExcelNormal()
With Excel.Application
.Cursor = xlDefault
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub
Sub ExcelBusy()
With Excel.Application
.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.StatusBar = False
End With
End Sub
Note: In the future Probably Code Review would be better place to post.
I am not new to programming, but I am new to using macros in Excel. I am using Excel 2010, trying to run the following macro:
Sub HideUnhideCells(ByVal Target As Range)
Dim keyCell As Range
Set keyCell = Range("C9")
Dim Cells1 As Range
Dim Cells2 As Range
'Call the function on C9 cell change
If Target.Address = "$C$9" Then
'Make Data Source available for for DRG and UCR
If keyCell.Value = "DRG" Or keyCell.Value = "UCR" Then
Set Cells1 = Range("C33")
Cells1.EntireRow.Hidden = False
Else
Set Cells1 = Range("C33")
Cells1.EntireRow.Hidden = True
End If
'Make MSA special cells available if MSA is selected
If keyCell.Value = "MSA" Then
Set Cells1 = Range("B34:C35")
Cells1.EntireRow.Hidden = False
Else
Set Cells1 = Range("B34:C35")
Cells1.EntireRow.Hidden = True
End If
'Make UCR cells available if UCR is selected
If keyCell.Value = "UCR" Then
Set Cells1 = Range("B36:C39")
Cells1.EntireRow.Hidden = False
Else
Set Cells1 = Range("B36:C39")
Cells1.EntireRow.Hidden = True
End If
'Remove extra name cells for 1-file and 2-file values
If keyCell.Value = "DRG" Or keyCell.Value = "ICD-9" Or keyCell.Value = "NCCI_Edits" Or keyCell.Value = "UB04" Then
Set Cells1 = Range("B21:C25")
Set Cells2 = Range("B28:C32")
Cells1.EntireRow.Hidden = True
Cells2.EntireRow.Hidden = True
ElseIf keyCell.Value = "ICD-10" Or keyCell.Value = "NDC" Then
Set Cells1 = Range("B22:C25")
Set Cells2 = Range("B29:C32")
Cells1.EntireRow.Hidden = True
Cells2.EntireRow.Hidden = True
Else
Set Cells1 = Range("B21:C25")
Set Cells2 = Range("B28:C32")
Cells1.EntireRow.Hidden = False
Cells2.EntireRow.Hidden = False
End If
End If
End Sub
I have seen several postings and tutorials that talk about this, but I can't understand why this won't work. Cell C9 is a dropdown list, and I want this macro to run so that cells are shown / not shown based on what is selected in the list. However, if I give it parameters (as shown above) I can't run it in the UI, and if I don't give it parameters, I can only run it manually, which doesn't help me much.
Right now, when I select something from that C9 dropdown list, nothing happens. Can anyone help me figure out why?
Your code looked ripe for a Select Case treatment and there were several things to add about the Worksheet_Change event macro (too many for a comment) so I went ahead and wrote up a draft of the Sub Worksheet_Change. I'm not sure if I have interpreted all of the If ElseIf Else End If but perhaps you can see what I'm trying to do with this.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$9" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Whoa
Rows("21:25").EntireRow.Hidden = False
Rows("28:32").EntireRow.Hidden = False
Rows("33:39").EntireRow.Hidden = True
Select Case Target.Value
Case "DRG"
Rows("33").EntireRow.Hidden = False
Case "MSA"
Rows("34:35").EntireRow.Hidden = False
Case "UCR"
Rows("33").EntireRow.Hidden = False
Rows("36:39").EntireRow.Hidden = False
Case "DRG", "ICD-9", "NCCI_Edits", "UB04"
Rows("21:25").EntireRow.Hidden = True
Rows("28:32").EntireRow.Hidden = True
Case "ICD-10", "NDC"
Rows("22:25").EntireRow.Hidden = True
Rows("29:32").EntireRow.Hidden = True
Case Else
'do nothing
End Select
End If
FallThrough:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume FallThrough
End Sub
Post back into Comments with any problem you have transcribing this for your own purposes and I'll try to assist.
I am creating macro which will loop through column F and will delete month april from 2013. It seem that the macro is deleting all :-D. I dont know how to set it to delete only my criteria I tried (Month(Now) - 2). Mine date of format looks like DD/MM/YYYY.
Thank you for your help.
Sub Test1()
Dim rgFoundCell As Range
Dim toBeDeted As Range
Dim firstAddress
With Sheets("Sheet1").Range("F:F")
Set rgFoundCell = .Find(What:=(Month(Now) - 2))
If Not rgFoundCell Is Nothing Then
firstAddress = rgFoundCell.Address
Do
If toBeDeted Is Nothing Then
Set toBeDeted = rgFoundCell.EntireRow
Else
Set toBeDeted = Union(toBeDeted, rgFoundCell.EntireRow)
End If
Set rgFoundCell = .FindNext(rgFoundCell)
If rgFoundCell Is Nothing Then Exit Do
Loop While rgFoundCell.Address <> firstAddress
End If
End With
Application.ScreenUpdating = True
If Not toBeDeted Is Nothing Then _
toBeDeted.Delete ' Delete
End Sub
You can't use .Find in the way you think - it is only able to do text match or number match comparisons. This leaves you with having to cycle through each cell in the range and run your comparison explicitly on each cell
Sub Test1()
Dim toBeDeleted As Range
With Sheets("Sheet1").Range("F:F")
For Each c In .Cells
If Month(c.Value) = 3 And Year(c.Value) = 2013 Then
If toBeDeleted Is Nothing Then
Set toBeDeleted = c.EntireRow
Else
Set toBeDeleted = Union(toBeDeleted, c.EntireRow)
End If
End If
Next
End With
If Not toBeDeleted Is Nothing Then _
toBeDeleted.Delete ' Delete
End Sub
You might want to consider running the function on a more refined range than the full F column or use an end of data marker like checking for a blank row to stop the loop.
Try this:
Sub Test1()
On Error GoTo e
Application.ScreenUpdating = False
Dim rng As Range
Dim firstAddress
Set rng = Sheets("Sheet1").Range("F1", Sheets("Sheet1").Range("F1").End(xlDown))
Dim i As Long
i = 1
While i <= rng.Count
If Month(CDate(rng(i))) = 4 And Year(CDate(rng(i))) = 2014 Then
rng (i).EntireRow.Delete
Else
i = i + 1
End If
Wend
x:
Application.ScreenUpdating = True
Exit Sub
e:
MsgBox (Err.Description)
Resume x
End Sub
Maybe try to reduce the F:F range!!!