I'm trying to use an if-condition regarding filters. I wish I could write a code to check if a specific filter is applied and then do something... (of course)
My first attempt was:
If ActiveSheet.Range("$D$4:$Q$20").AutoFilter Field:=2 then
Rows("22:22").Select
Selection.EntireRow.Hidden = True
End If
In the very first line, VBA doesn't accept the condition that is written...
Any guess?
tks
This will tell you if a range is in a filter and the filter is active:
Public Function IsFilterOn(rng As Range) As Boolean
Dim ws As Worksheet
Dim iFilterNum As Integer
Set ws = rng.Parent
If Not ws.AutoFilter Is Nothing Then
If Not Application.Intersect(rng, ws.AutoFilter.Range) Is Nothing Then
With ws.AutoFilter.Filters
iFilterNum = rng.Column - .Item(1).Parent.Range.Column + 1
If iFilterNum <= .Count Then
IsFilterOn = .Item(iFilterNum).On
Exit Function
End If
End With
End If
End If
End Function
Note that you don't need to select a row before hiding it.
Sub HideWhenFiltered()
With ActiveSheet
If .AutoFilterMode Then
If .AutoFilter.Filters(2).On Then
.Rows(22).Hidden = True
End If
End If
End With
End Sub
Related
I would really appreciate your help with following issue I am facing.
I want 3 rows to be hidden unless something is written in a specific cell.
If something is written in the specific cell I want the next row to become unhidden. And so it suppose to continue with the next two cells.
I have written the following code in th module, please guide me on how to solve this (what am I doing wrong?)
Sub InsertRow()
If Range("U6") <> "" Then
Rows("7").EntireRow.Hidden = False
Rows("8:9").EntireRow.Hidden = True
End If
End Sub
Not sure if this is what you want, but this goes through all used cells in col U and checks rows beneath
Public Sub InsertRow()
Dim targetCol As Range, itm As Range
Set targetCol = Worksheets("Sheet1").UsedRange.Columns(21) 'UsedRange starts at A1
Application.ScreenUpdating = False 'Update sheet name and column number
For Each itm In targetCol.Cells
itm.Offset(1).EntireRow.Hidden = (Len(itm.Value2) = 0)
Next
Application.ScreenUpdating = True
End Sub
Try this solution:
Sub InsertRow()
Rows("7").EntireRow.Hidden = Range("U6") = ""
Rows("8:9").EntireRow.Hidden = True
End Sub
I would like to check multiple named ranges for a boolean True/False value. I need to check the 1-cell validation ranges (in order) and if the result is True, I need to .Select the corresponding named range (i.e., the named range without the corresponding "validation_" prefix and exit the subroutine. The following code works, but it's not DRY.
Here's a snippet to get the gist of the question, but this If-ElseIf continues for many other named ranges:
If Range("validation_name") = True Then
Range("name").Select
Exit Sub
ElseIf Range("validation_category") = True Then
Range("category").Select
Exit Sub
ElseIf Range("validation_subcategory") = True Then
Range("subcategory").Select
Exit Sub
' ... and many more...
Possibilities/Questions:
I think I could utilize either an array of named ranges and an array of resulting "go-to" named ranges?
Perhaps I could use a collection instead?
Not sure if a for loop or a while loop would be better?
some "extra dry" codes
Sub main()
Dim a As Variant
For Each a In Array("name", "category", "subcategory")
If Range("valid_" & a).Value = True Then
Range(a).Select
Exit Sub
End If
Next a
End Sub
Sub main2()
Dim r As Range, f As Range
Set r = Union(Range("validation_date"), Range("validation_name"), Range("validation_subcategory"), Range("validation_category"))
Set f = r.Find(what:="true", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then Range(Replace(f.name.name, "validation_", "")).Select
End Sub
I assume that these are 1-cell ranges. If so, the following should work:
Sub SelectRange()
Dim i As long, A As Variant
A = Array("validation_name", "validation_category", "validation_subcategory")
For i = 0 To UBound(A)
If Range(A(i)).Value = True Then
Range(Split(A(i),"_")(1)).Select
Exit Sub
End If
Next i
End Sub
You can loop through all of the named ranges with something like:
Dim xlName As Name
For each xlName In ActiveWorkbook.Names
If xlName.Name Like "validation_*" And Range(xlName.Name) = True Then
Application.Goto Replace(xlName.Name, "validation_", ""), True
Exit Sub
End If
Next
or specify them like this
For each strName In Split("name category subcategory")
If Range("validation_" & strName) = True Then
Application.Goto strName, True
Exit Sub
End If
Next
Update
Sorry, I did not read the whole question. Seems like you can use some kind of key - value Collection
pairs = Array( Array( "validation_name", "name" ), _
Array( "validation_category", "category" ), _
Array( "validation_subcategory", "subcategory" ) )
For each pair In pairs
If Range( pair(0) ) = True Then
Application.Goto pair(1), True
Exit Sub
End If
Next
It's the first time I'm trying some VBA code, so it might be a very noob mistake but I just can't see it, this is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If InRange(ActiveCell, Range("N4:N33")) Then
If InStr(1, ActiveCell.Text, "EFECTIVO") > 0 Then
If (Not IsEmpty(ActiveCell.Offset(0, -1))) Then
If (ActiveCell.Offset(0, -1).Value > 0) Then
Cancel = True
Call RestaEfectivo
Range("F4").Select
End If
End If
End If
End If
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
Sub RestaEfectivo()
Range("F4").Value = Range("F4").Value - ActiveCell.Offset(0, -1).Value
End Sub
The idea is that I have a dropdown list on my cells N4 to N33, whenever I choose the option "EFECTIVO" it should take the value to the left of the ActiveCell (N#) and substract its value from the F4 cell. In essence F4 = F4 - N#.
The code does what it's supposed to do, however, it appears to execute 50 times? The original value of my F4 cell is 230, once I execute the code it turns into -20
Any idea where I messed up or if I'm missing some code, validation, etc?
As I said, I'm new to VBA for Excel Macros, so don't worry about pointing out noob mistakes.
You need to toggle the EnableEvents property of Application at the point where you call your RestaEfectivo sub-routine. Notice that during handling the Worksheet_Change event you call the RestaEfectivo sub-routine which fires the worksheet change event again - that is why your macro executes more than once.
You can make the code change like this:
Cancel = True
' turn off events to enable changing cell value without a new 'change' event
Application.EnableEvents = False
Call RestaEfectivo
' re-enable events to ensure normal application behaviour
Application.EnableEvents = True
Range("F4").Select
Update
OP asked a follow up question - how to make the range dynamic but ignore the bottom row as this would contain a SUM formula.
One possible solution is to check for the change in any cell of column N:
If InRange(ActiveCell, Range("N:N")) Then
And then recode the InRange sub - see the code comments for logic and assumptions:
Function InRange(Range1 As Range, Range2 As Range) As Boolean
Dim blnInRange As Boolean
Dim blnResult As Boolean
Dim blnCellHasSumFormula As Boolean
Dim blnCellIsEmpty As Boolean
'primary check for cell intersect
blnInRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
If blnInRange Then
'follow-up checks
blnCellIsEmpty = (Range1.Value = vbNullString)
If blnCellIsEmpty Then
'cell in range but empty - assume beneath row with SUM
blnResult = False
Else
If Range1.HasFormula Then
'check for sum formula
blnCellHasSumFormula = (InStr(1, Range1.Formula, "SUM(", vbTextCompare) > 0)
If blnCellHasSumFormula Then
' cell in the SUM row
blnResult = False
Else
' cell is in range, not empty and not a SUM formula
blnResult = True
End If
Else
'assume non-empty cell without formula is good
blnResult = True
End If
End If
Else
blnResult = False
End If
'return to event handler
InRange = blnResult
End Function
I am new to VBAing but have a small amount of javascript knowledge and hoping for a bit of guidance/help as I can't seem to get the code working. There's probably some glaring mistakes so thanks for the patience.
I'm trying to get a spreadsheet to update a sheet upon that sheet's activation, where it will hide columns whose 2nd row cell is "blank" (or the formula x(y) in the cell is null).
Below is what have tried so far.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "FSM" Then
Function hideBlankColumns()
i = 2
For i = 2 To 30
If IsNull(Cells(2, i).Value) = True Then
Columns(i).EntireRow.Hidden = True
Else: Columns(i).EntireRow.Hidden = False
End If
Next i
End Function
End If
End Sub
Thanks in advance!
You have three errors in your code:
you cannot define a function inside another sub.
you are talking about hiding/unhiding columns, but in the code you hide rows: Columns(lCol).EntireRow.Hidden = True
function IsNull always returns False if you pass Excel cell or its value as a parameter. In this case you should use function IsEmpty instead.
This code should work properly:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim i As Integer
If Sh.Name = "FSM" Then
For i = 2 To 30
Columns(i).EntireColumn.Hidden = IsEmpty(Cells(2, i).value)
Next i
End If
End Sub
Try something like this.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "FSM" Then
lCol = 2
Do While lCol <= ws.UsedRange.Columns.count
If IsNull(Cells(2, lCol).Value) = True Then
Columns(lCol).EntireColumn.Hidden = True
Else
Columns(lCol).EntireColumn.Hidden = False
End If
lCol = lCol + 1
Loop
End if
End sub
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!!!