Excel VBA Clear indirect dropdown cell within a column range - excel

I have successfully used the code below to clear the contents of an indirect cell based on a change of a dropdown list in order to prevent mismatched data.
For example my first drop down cell is D2 and has 3 options, when an option is selected, my second cell F2 (based on named ranges) changes to show the choices specific to the selected option.
When a user changes the first option in D2, the code triggers and clears out the contents of F2 so a new selection can be made preventing mis-matched data.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'Clear Adjustment Reasons if there is a change of Type'
If Target.Address = "$D$2" Then
If Target.Validation.Type = "$F$2" Then
Application.EnableEvents = False
Target.Offset(0, 2).ClearContents
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
What i'm looking to do is now extend this so it can work on a sheet where the dropdown lists will be in each cell of a column (ranged from M7:M500), and the indirect dropdown in each cell of (ranged from N7:N500)
So, when the user changes the original option in any of the cells in the M range, then the corresponding N cell in the same row will clear.
Does anyone know any examples i could potentially look at to make this work?

Related

Stopping a macro if there's no value entered

I want my macro to stop if there's no value entered in any of the four cells I need. But i want it to run if there's at leats one value in those four cells.
This is what i have so far:
If Range("e12,h12,k12,d12").Value = "" Then
MsgBox ("Por favor introducir dimensiones")
Range("e12").Select
Exit Sub
End If
If you introduce a value in cell e12, it will run. But if you introduce a value in any other cell, the msgbox will pop out and the macro will stop.
Could you help me find the problem?
Thank you!
Please install the event procedure below in the code sheet of the worksheet on which you want the action.
Private Sub Worksheet_Change(ByVal Target As Range)
Const Triggers As String = "E12,H12,K12,D12"
Dim Rng As Range
Dim Cell As Range
' skip if more than one cell was changed (like paste)
If Target.Cells.CountLarge = 1 Then
Set Rng = Range(Triggers)
For Each Cell In Rng
If Cell.Value = "" Then
Cell.Select
Exit For
End If
Next Cell
End If
End Sub
Now, if the user enters something in E12 the macro will select H12. If the user enters something in D12 next the macro will take him back to K12. That's all very nice.
But if the user changes something in A3 (anywhere, in fact) he will be taken to the first empty cell of the trigger range. Therefore the system must be tweaked to accommodate your workflow. Perhaps the code should be made to run only when D12 is entered, or when the user clicks on the cell he shouldn't click on before completing the trigger range.
In short, the scope of the procedure may have to be trimmed to suit your workflow. This can be done by either including specific cells in the trigger range, or by excluding other cells.
you coudl use WorksheetFunction.CountA() function to count the number of not empty cells:
If WorksheetFunction.CountA(Range("e12,h12,k12,d12")) <> 4 Then
MsgBox ("Por favor introducir dimensiones")
Range("e12").Select
Exit Sub
End If

Automatic Sheet Calculation (Checkbox linked to cell)

I'm working on a table where I've inserted some Checkboxes (Form Control) which are linked to cells that return True or False when either Checkbox is ticked.
I wrote a code that should change the cell's color according to the returned value.
The code works fine but only when I double click the cell and validate by pressing Enter, or when I run the Sub by hitting F5 or a clicking a button.
(I used a similar code that updates everything automatically in another project but it doesn't seem to work here)
How can I make the Sub run automatically (or the sheet update) once a checkbox is ticked?
Here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A2:Q21"), Range(Target.Address)) Is Nothing Then
Dim cell As Range
For Each cell In ActiveWorkbook.Sheets("Sheet1").Range("A2:Q21")
If cell.Value = "True" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value = "False" Then
cell.Interior.Color = vbRed
End If
Next
End Sub
I know I could use conditional formatting but this sheet will expand rapidly and I don't see myself copy-pasting hundreds of checkboxes
As the sheet will expand I think it'll be better to include a "lastRow" statement since I will be adding new rows at the bottom using a UserForm
Thanks!
You should extract the part doing the coloring to a new function and call that from both the original and from the checkbox's event handler.
' In Sheet1 Module
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A2:Q21"), Range(Target.Address)) Is Nothing Then
ColorCells
End If
End Sub
' In Module1 Module
Sub CheckBox1_Click()
ColorCells
End Sub
Public Sub ColorCells()
Dim cell As Range
For Each cell In ActiveWorkbook.Sheets("Sheet1").Range("A2:Q21")
If cell.Value = "True" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value = "False" Then
cell.Interior.Color = vbRed
End If
Next
End Sub
Update
If there are too many checkboxes than you may use the Worksheet's Calculation event handler assuming that the checkboxes have Linked Cells and some other Cell refers to their value.
' In Sheet1 Module
Private Sub Worksheet_Calculate()
ColorCells
End Sub
Note, if the checkbox does not have a Linked Cell, it won't work. If the checkbox has a Linked Cell but it is not referred to by any other cell, it won't work. This is because in these cases no recalculation will be initiated.
You can test this: Assign A1 to a Checkbox (on a new sheet), and try if the macro runs (should not), then write in A2 =2*--A1, and check again, now it should work.
If you want to minimize the footprint of this requirement, find an unused cell on the sheet and enter the following formula: =INDEX(1:1048576,1,1). This refers to all cells but it does not require a lengthy calculation. Of course, if you want to place it into A1, you should change the ,1,1 part to something else to avoid circular references.
Instead of firing your colouring sub at Worksheet_Change, put it under Worksheet_Calculate. Then insert the formula =A1:Q21(or whatever you need to cover your range) somewhere in your sheet. It will resolve to #value but that isn't important. This formula will force your sheet to automatically recalculate when anything within its range is changed, including the cells linked to your checkboxes. And then upon recalculate it will fire the sub that colours your cells correctly.

How to clear cells when another cell becomes empty?

I'm making a list of items and totaling each item's quantity and weight.
The name of the item goes in A1, the weight of goes in C1, and the quantity goes in D1.
E1 is a formula to calculate the total weight by multiplying C1 and D1.
When I clear the contents of an item in A1, I want to automatically clear the cells of C1 and D1, which in turn will clear the weight from E1 and the total of all items later in the page?
I'd like something that would repeat for specified cells from A1-A31, and that would work automatically when I delete a cell's contents and hit enter.
You need the Worksheet.Change event to do this automatically, something like this:
Add the following code to that sheet's code module (right click on the sheet tab and hit View Code to bring it up):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1:A31")) Is Nothing Then Exit Sub
Dim rng As Range
For Each rng In Intersect(Target, Me.Range("A1:A31"))
If IsEmpty(rng) Then
On Error GoTo ErrorHandler
Application.EnableEvents = False
rng.Offset(, 2).Resize(, 2).ClearContents
End If
Next rng
ErrorHandler:
Application.EnableEvents = True
End Sub

Auto-fill the date in a cell, when change is made into an adjacent cell

I found code to work in Excel that almost does what I need.
My need is to have today's date added automatically in one column's cell when a change is made in another column's cell. So if I click in Column M Row 20's cell & change data or add data (in this case it is a Status column with a dropdown list) then in Column N Row 20's cell it will put today's date or replace old date with today's date. (Every time Status dropdown is changed.)
This code does that for 2 different columns because I altered it.
The Problems:
If I insert rows it will put today's date in the newly inserted
rows or if I delete rows, let's say 3 rows it will add the date or
overwrite the date in the 3 rows below the 3 just deleted. This is
not good. I only want a date added if I make a change in the cell
itself. Simply auto add date when we add or change the status (Data)
in the cell to the left of it.
Also I need the top 9 rows not to be affected by this auto date
add.
Lastly if I double click in Column M Row 20's cell but do not
enter any data then click out of the cell it will still add date to
Column N Row 20's cell.
I found the original code at:
Auto-fill the date in a cell, when the user enters information in an adjacent cell
My version of the code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, M As Range, X As Range, Inte As Range, r As Range
Set A = Range("M:M,X:X")
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
These modification take care of your first two specifications.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M,X:X"), Range("10:" & Rows.Count)) Is Nothing Then
If Target.Count < Columns.Count Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim r As Range
For Each r In Intersect(Target, Range("M:M,X:X"), Range("10:" & Rows.Count))
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "dd-mmm-yyyy hh:mm:ss" 'change to what you prefer
End With
Next r
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
As far as the third, I would humbly suggest that you get used to using the preferred method of tapping Esc to abandon an 'in-cell' edit rather than Enter↵ or selecting another cell. Using Esc does not change the value in the cell and the Worksheet_Change event macro is not triggered. Using Enter or selecting another cell DOES change the value in the cell and coding against lackadaisical practises is simply not worth the overhead when proper keyboard practises could be applied.
Addendum:
If your hand is still on the mouse, you can also click the × in the formula bar to [Esc] an in-cell edit.
        

Create macro upon double click cell display filter in new sheet

I have a question regarding creating macros whereas the scenarios as follows:
Sheet1
Upon clicking any cell in Sheet1, it will automatically filter based on cell A and B.
Sheet2
Automatically display filtered criteria based on double click from Sheet1
For example: when I double click on C1, on Sheet2 will automatically diplay filtered data based on A1 and B1 and same thing goes to if I double clik on C2 on Sheet2 will automatically diplay filtered data based on A1 and B2.
Really need help from the experts here.
This would be the code you need to catch your single-click event:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Debug.Print Target.Address
End Sub
This would be the code you need to catch your double-click event:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Debug.Print Target.Address
'cancel the double click, prohibiting editng of cell per double-click
Cancel = true
End Sub
I would have helped you with your filtering too, but since you did not paste any code to that, and I don't get how excactly you want what data to be filtered, I'll leave that up to you ;)
Edit:
This code can be used for Worksheet_SelectionChange and will set a filter based on a valid selection inside the used range. If a filter is already in place, it will be deactivated.
On Error Resume Next
If Sheet1.AutoFilterMode Then
'clear existing autofilter
Sheet1.UsedRange.AutoFilter
Else
'setup filter based on selection
Sheet1.UsedRange.AutoFilter field:=Target.Column, _
Operator:=xlFilterValues, _
Criteria1:=Target.Value, _
VisibleDropDown:=True
End If

Resources