I'm fairly new to VBA and have been trying to get my spreadsheets to do a little more than just pivot tables allow. I've been able to set up some autofilters in excel using VBA, but now I'd like to have the worksheet autofilter after I enter data into a cell. However, neither of the two lines below work after I press enter.
Here are the two various lines of code I've tried:
1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$5" Then
Application.EnableEvents = False
FilterTo1Critera
Application.EnableEvents = True
End If
End Sub
2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cel As Range
Set ws = ThisWorkbook.Sheets("Sheet3")
If Not Intersect(Target, Range("A3")) Is Nothing Then
For Each cel In Target
Range("A3").Value = "Changed"
Application.EnableEvents = False
If IsEmpty(ws.Range("A")) Then Sheet1.Range("A").Value = 0
Application.EnableEvents = True
Next cel
End If
End Sub
What's the correct approach to take? Also, is there some good classes that I can take to brush up on some of these concepts??
Thanks in advance!
Related
I have a list of "activities" in column B and each of them has a drop-down list for the status in column C. For each activity I can select "Done, In progress, TBD, Cancelled". What I want is to hide a row automatically (not filtering) every time I choose the status "Cancelled" in the drop-down (located in the same row).
The code used is below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("C2:C21")
If Target.Address <> Range("C2:C21").Address Then
Exit Sub
Cells.EntireRow.Hidden = False
Select Case Range("C2:C21")
Case "Cancelled":
Range("2:21").EntireRow.Hidden = True - ***I want to hide only those rows in which "Cancelled" is selected.***
Case "Done":
Range("2:21").EntireRow.Hidden = False - ***I want the rows to unhide if either "Done","In progress" or "TBD" is selected.***
End Select
End Sub
It's probably a terrible code for what I want to do...
Any idea on how to improve this?
Thanks a lot in advance! :)
Sara
The rng object has never been used.
If you want to check the selection is in Range("C2:C21") or not, use a Intersect function.
The If statement can be completed without an End If only if it is one-lined. Otherwise you have to put an End If at the end.
Range("2:21").EntireRow.Hidden means every rows in 2:21 are going to be hidden.
Code:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
For Each cel In rng
cel.EntireRow.Hidden = IIf(cel.Value = "Cancelled", True, False)
Next cel
End If
End Sub
I'm not sure the version below is fitted or not. In my opinion, generally this macro should only be run after something is changed, and we can only check the row who has been changed, other rows should remain the same state.
Private Sub Worksheet_Change(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
target.EntireRow.Hidden = IIf(target.Value = "Cancelled", True, False)
End If
End Sub
This is another option, skipping the If and Select Case:
Private Sub Worksheet_Change(ByVal target As Range)
Dim myRng As Range
Dim myCell As Range
Set myRng = Range("C2:C21")
If Not Intersect(myRng, target) Is Nothing Then
Cells.EntireRow.Hidden = False
For Each myCell In myRng
myCell.EntireRow.Hidden = CBool(myCell = "Cancelled")
Next myCell
End If
End Sub
The "beauty" is that the If condition is eliminated and the .Hidden is assigned to a direct evaluation of myCell = "Cancelled";
Furthermore, the code is in a worksheet, as far as the _SelectionChange event is used. Then the parent worksheet of the range could be omitted, as far as it is taking the worksheet in which the code resides. So - Target.Parent.Range could be nicely skipped.
I am trying to run this worksheet change event for two different columns(A) and (I)...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(0, 1).Value = Date
Next r
Application.EnableEvents = True
End Sub
This event is something i found on this forum. Its purpose is to make it so whenever data is ever entered into column "a" it auto inputs the date into the cell directly right of it. I want this to happen twice on the worksheet. I can't figure out how to change/add to it. I am trying to get it to run the logic for column A and I on my spreadsheet.
Just expand the range you set to the A variable.
Set A = Range("A:A, I:I")
Rewritten as,
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(range("A:A, I:I"), target) is nothing then
'add error control
on error goto safe_exit
'don't do anything until you know something has to be done
dim r as range
Application.EnableEvents = False
For Each r In intersect(range("A:A, I:I"), target)
r.Offset(0, 1).Value = Date 'do you want Date or Now?
Next r
end if
safe_exit:
Application.EnableEvents = True
End Sub
edited after OP's comment
expanding on #Jeeped solution, you can avoid looping:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A:A, I:I"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
I have an Excel workbook with multiple worksheets. I have a cell in WORKSHEET A with range name TRACK1 and a cell in WORKSHEET B with range name TRACK2.
Each TRACK1 and TRACK2 are validated from a list. The user can change either cell from the drop-down list shown when the cell is selected.
I want to be able to allow the user to change either and have the other be also changed to match. Change value of TRACK1 and TRACK2 is changed, and vice versa.
I know how to do this basic macro, but how to stop the event propagating?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("TRACK1")) Is Nothing Then
Range("TRACK2") = Range("TRACK1")
End If
If Not Application.Intersect(Target, Range("TRACK2")) Is Nothing Then
Range("TRACK1") = Range("TRACK2")
End If
End Sub
In worksheet A's code module, use:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("TRACK1")) Is Nothing Then
Worksheets("WORKSHEET B").Range("TRACK2") = Range("TRACK1")
End If
Application.EnableEvents = True
End Sub
In worksheet B's code module, use:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("TRACK2")) Is Nothing Then
Worksheets("WORKSHEET A").Range("TRACK1") = Range("TRACK2")
End If
Application.EnableEvents = True
End Sub
I used to have the following code and it used to work but for some reason it no longer works.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim KeyCells As Range
Dim i As String
Set KeyCells = Range("AF3:AF5000")
test = Target.Rows.Count
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
For i = Target.Row To (Target.Row + (Target.Rows.Count - 1))
If Not ActiveSheet.Cells(i, 32) = "" Then
ActiveSheet.Cells(i, 20).Value = "Closed"
End If
Next
End If
End sub
Basically if there is data in any cells of column AF then the cell align with the information in column T would mark Closed. For example if AF65 <>"" then T65.value ="Closed"
Any idea why it no longer works or if there is another possibility for a macro?
Get rid of the redundant code and non-specific worksheet references. For example, a Worksheet_Change can be triggered when that worksheet is not the Activesheet; putting in Activesheet when it is not required only confuses the issue.
You also are not disabling events so your sub is going to try to run on top of itself.
This should be closer to what you are attempting to perform.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange)
If CBool(Len(trgt.Value2)) Then
trgt.Offset(0, -12) = "Closed"
Else
trgt.Offset(0, -12) = vbNullString
End If
Next trgt
End If
safe_exit:
Application.EnableEvents = True
End Sub
If your original sub just 'stopped working' then put Application.EnableEvents = True into the VBE's Immediate window and tap [enter]. It is possible that your earlier code crashed with event handling disabled.
i'm still fairly new to macros, i've got a bit of code i need to run on a sheet every time it gets updated, changed, or whatever.
Here is the code I need to run: How can i do this?
Sub UnMergeFill()
Dim cell As Range, joinedCells As Range
For Each cell In ThisWorkbook.ActiveSheet.UsedRange
If cell.MergeCells Then
Set joinedCells = cell.MergeArea
cell.MergeCells = False
joinedCells.Value = cell.Value
End If
Next
End Sub
You can boost the efficiency of your macro by locating the merged cells to process rather than looping through every cell in the Worksheet.UsedRange property and examining it for the Range.MergeCells Property.
Within the worksheet's conventional Range.Find method, there is an option to look for formatting. On this sub-dialog's Alignment tab, you'll find the option to locate Merged cells.
This can be incorporated into your VBA sub procedure using the Range.Find method and the Application object's .FindFormat property.
Your sub procedure using FindFormat:
Sub UnMergeFill(Optional ws As Worksheet)
If ws Is Nothing Then Set ws = ActiveSheet
Dim fndMrg As Range, joinedCells As Range
Application.FindFormat.MergeCells = True
With ws
On Error Resume Next
Set fndMrg = .Cells.Find(What:=vbNullString, SearchFormat:=True)
Do While Not fndMrg Is Nothing
Set joinedCells = fndMrg.MergeArea
fndMrg.MergeCells = False
'fndMrg.UnMerge '???
joinedCells.Value = fndMrg.Value
Set fndMrg = .Cells.Find(What:=vbNullString, SearchFormat:=True)
Loop
End With
Application.FindFormat.MergeCells = False
End Sub
Slightly revised Worksheet_Change event macro with more environment shutdown during processing.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Call UnMergeFill(Target.Parent)
bm_Safe_Exit:
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I've opted to specify the worksheet to be processed rather than rely on the ActiveSheet property. There is the possibility that the Worksheet_Change could be initiated by an outside process when it is NOT the active sheet.
In short, opt for bulk operations whenever possible and avoid looping whenever you can. This is not blinding fast but it should be substantially quicker than looping through the cells.
In the code module for that particular worksheet, just add this:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
UnMergeFill
Application.EnableEvents = True
End Sub