I am new to VBA and was wondering how I combine 2 worksheet_change scripts, or if there is something else I should use.
I have a dropdown list which when selected give dependancy to another dropdown list.
For the first dropdown I have code which filters the columns so the other columns are hidden. There are several columns which have the same text in row 3 making multiple columns associated with the first dropdown. The code below works fine for B2.
Users may stop at the first dropdown, but if they then select the second dropdown I need the spreadsheet to filter the columns further so only one column is displayed. The heading titles are in row 4.
At the moment I have:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Dim the_selection As String
Dim the_group As String
the_selection = Sheet1.Range("B2")
Dim Rep as Integer
For Rep = 5 to 100
the_column = GetColumnLetter_ByInteger(Rep)
the_group = Sheet1.Range(the_column & "3")
If the_selection = the_group Then
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
End Sub
If I try and create a Worksheet_SelectionChange for the C2 dropdown it sort of works but I have to click out of the cell and then in again for it to filter properly. This is not ideal. Is there a way of incorporating the codes together in the Worksheet_change.
Additionally, is it possible for the second selection to also filter the rows so only those with values appear and the blank ones are hidden? The second filter would always filter to one column and never more than one. What code would I add to reset the row filter when a user selected another dropdown?
Any help is appreciated.
Lando :)
Your original code could be rewritten as
Private Sub Worksheet_Change(ByVal Target As Range)
Dim the_selection As String
Dim the_group As String
Dim Rep As Long
If Target.Address = "$B$2" Then
the_selection = Sheet1.Range("B2") 'If this code is in Sheet1 you can just use "the_selection=Target".
For Rep = 5 To 100
the_group = Sheet1.Cells(3, Rep)
Sheet1.Columns(Rep).Hidden = (the_selection <> the_group)
Next Rep
End If
End Sub
Sheet1.Columns(Rep).Hidden requires TRUE or FALSE to hide/show the
column.
(the_selection <> the_group) will return TRUE if
the_selection is different from the_group and FALSE if not.
Your combined code could be:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim the_selection As String
Dim the_group As String
Dim Rep As Long
If Not Intersect(Target, Range("B2:C2")) Is Nothing Then
the_selection = Target
'Unhide all columns if B2 is changed.
If Target.Address = "$B$2" Then
Sheet1.Columns.Hidden = False
End If
For Rep = 5 To 100
the_group = Sheet1.Cells(Target.Column + 1, Rep)
Select Case Target.Address
Case "$B$2"
Sheet1.Columns(Rep).Hidden = (the_selection <> the_group)
Case "$C$2"
If Not Sheet1.Columns(Rep).Hidden Then
Sheet1.Columns(Rep).Hidden = (the_selection <> the_group)
End If
End Select
Next Rep
End If
End Sub
The code will take the value from B2 or C2 (the_selection=Target).
B2 looks at row 3, C2 looks at row 4 - column B is also column 2, column C is also column 3 so the code just adds one to get the correct row number (the_group = Sheet1.Cells(Target.Column + 1, Rep)).
If the value being changed is C2 then you don't want to unhide any columns already hidden by B2 so the code checks if the column is not already hidden before attempting to hide it (If Not Sheet1.Columns(Rep).Hidden Then)
Related
I have two tables in Excel that come from VBA data extraction from some other software.
I’d like for the common values in the NAME column on each table to be linked.
If, for instance, I replaced ABC02 in the second table with ABC03 then the first table’s ABC02 would be replaced with ABC03 as well.
Conversely a change in the first table would lead to a change in the second one.
I tried using the Handle value to mark identical values with the following code:
Sub Test1()
Dim i, y As Integer
For i = 10 To 11
y = 7
Do Until y = 5
y = y - 1
If Range("C" & y).Value = Range("C" & i).Value Then
Range("D" & y).Value = Range("B" & i).Value
End If
Loop
'' Action :
Next i
End Sub
Which gave this result:
How do I efficiently do it both ways (meaning getting the handles of similar values for the other table as well) to get that result:
and how to go from there (or even if I should do that at all).
This is a synchronisation issue and there is no quick and easy solution for that. What I would do is to use 2 event handlers of VBA: Worksheet_SelectionChange and Worksheet_Change. With the Worksheet_SelectionChange you can detect where the user has clicked and save the original value and address of the cell to some globally accessible variables. Then with the Worksheet_Change you can detect the user changes the value of the cell. Then you will have the original and the new value of cell. You need to manage multiple selection either, I give you a simple example in the following snippet.
Public origval As Variant, origaddr As Variant
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
origval = Target.Cells(1).Value
origaddr = Target.Cells(1).Address ' this is to handle multiple selection
Range(origaddr).Select ' reset multiple selection
End Sub
Public Sub Worksheet_Change(ByVal Target As Range)
' at this point
' - origval contains the original value
' - origaddr and Target.Address contains the cell address (should be the same)
' - Target.Value contains the new value of the cell
' - Target.Address contains the cell address
' - Target.Parent.Name contains the name of worksheet
' - Target.Parent.Parent.Name contains the name of workbook
' so you know everything you need and you can decide how to go on
End Sub
NB: the trick in SelectionChange is rather a "dirty" one. This is just a reminder to handle multiple selection, too.
Someone from another forum posted the following answer (so I'm posting it here in case anyone is looking for the same thing):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Variant
Application.EnableEvents = False
Set f2 = Sheets("Image")
If Not Intersect(Target, Columns(3)) Is Nothing Then
If Range(Target.Address).Value <> f2.Range(Target.Address).Value Then
TargetImage = f2.Range(Target.Address).Value
With f2
Set x = Columns(3).Find(TargetImage)
If Not x Is Nothing Then
Pos = x.Address
Do
If x.Row <> Target.Row Then
Cells(x.Row, "C") = Target.Value
'Modification of the Image sheet
f2.Cells(x.Row, "C") = Target.Value
f2.Range(Target.Address).Value = Target.Value
Else
Set x = .FindNext(x)
End If
Loop While Not x Is Nothing And x.Address <> Pos
End If
End With
End If
End If
Set f2 = Nothing
Application.EnableEvents = True
End Sub
This code assumes that:
There are 2 identical sheets and the second one is called "Image"
The user input is in the first sheet
The values we want to replace are both in the 3rd column
There are no duplicate values within the same table
If you want to execute another macro beforehand (like I do with my data extraction) you have to use that bit of code within that macro
On Error GoTo ErrHandler
Application.EnableEvents = False
'Your code here...
ErrHandler:
Application.EnableEvents = True
If somehow you modify that Worksheet_Change macro and get an error, you have to fix that error and enable events again with another macro like this one:
Sub ReenableEventsAfterError()
Application.EnableEvents = True
End Sub
I have a large workbook and am trying to increase performance.
Is it possible/viable to store my formulas in some sort of list contained within the code rather than in the cells on the spreadsheet?
Variable SelectedRow = the currently selected row
For example:
ColumnBFormula = A(SelectedRow) + 1
ColumnCFormula = A(SelectedRow) + 2
If the user enters 4 in cell A3, then the macro writes formulas above ONLY in empty cells B3 and C3, then converts to values. The rest of the spreadsheet remains unchanged (should only have values everywhere).
Then the user enters a 6 in cell A4 and the spreadsheet writes the formulas to empty cells B4 and C4, calculates then converts to values.
Thanks
Try:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lastrow As Long
'Refer to Sheet1
With ThisWorkbook.Worksheets("Sheet1")
'Check if Column A affected
If Not Intersect(Target, Range("A:A")) Is Nothing And IsNumeric(Target) Then
'Disable event to avoid event trigger
Application.EnableEvents = False
Target.Offset(0, 1).Value = Target + 1
Target.Offset(0, 2).Value = Target + 2
'Enable event
Application.EnableEvents = True
End If
End With
End Sub
Instructions:
Enable Events:
Given you know what you want the code to do, you could do this without entering formulas.
In the VBA editor, add this code into the "ThisWorkbook" object ...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim objCell As Range
Application.EnableEvents = False
For Each objCell In Target.Cells
If objCell.Column = 1 Then
If objCell.Value = "" Then
objCell.Offset(0, 1) = ""
objCell.Offset(0, 2) = ""
Else
objCell.Offset(0, 1) = objCell.Value + 1
objCell.Offset(0, 2) = objCell.Value + 2
End If
End If
Next
Application.EnableEvents = True
End Sub
Hopefully that works for you.
FYI - You'll need to add the relevant error checking for values if not numeric etc, it will need to be improved.
I have a cell A1 which extracts values from a server every n seconds, however using the macro below (which is currently used) is not suitable:
Dim preVal As String
Dim count As Integer
'Intention is if cell A1 changes, record changes to Column C and Column D
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A1") Then
Call cellchange(Range("A1"))
End If
End Sub
Private Sub cellchange(ByVal a As Range)
'If row is empty, filled into that row, if not skip to next one
If a.Value <> preVal Then
count = count + 1
'copy the value of A1 from sheet 1
preVal = Sheets("Sheet1").Range("A1").Value
Cells(count, 4).Value = a.Value
'copy the values of time of which data change detected
Cells(count, 3) = Now()
End If
End Sub
In a simplest way, the cell A1 will be updated every few seconds from a server, so I need the macro to be updated/trigger when it detects changes in cell A1 that are not from human input.
You need to use something that really checks if your target cells is updated. usually application.intersect are used. Here I am using address property.
Dim preVal As String
Dim count As Integer
'Intention is if cell A1 changes, record changes to Column C and Column D
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.address = Range("A1").address Then
cellchange target
End If
End Sub
Private Sub cellchange(ByVal a As Range)
'If row is empty, filled into that row, if not skip to next one
If a.Value <> preVal Then
count = count + 1
'copy the value of A1 from sheet 1
preVal = Sheets("Sheet1").Range("A1").Value
Cells(count, 4).Value = a.Value
'copy the values of time of which data change detected
Cells(count, 3) = Now
End If
End Sub
Hope it helps.
Regards,
M
I have an excel spreadsheet of a BOM that I'm trying to conditionally format. The data is laid out such that column A is the item number. Since the BOM has alternates, there are repeated numbers. I want to go through the spreadsheet and for each item number, find the item with "Active" in column F and highlight them green and hide the alternates on the other rows. If there is no "active" item, I want to highlight the items as yellow and keep them displayed. I have the current vba script which does the highlighting. If you look at the example data I basically want a single line for each item number which shows the active part, but if there is no active part, to show the historical or discontinued parts in yellow
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim icolor As Integer
Dim lastrow As Long
Dim i As Integer
Dim cell As Range
Dim sheetname As String
sheetname = Application.ActiveSheet.Name
With Worksheets(sheetname)
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Application.ScreenUpdating = False
For Each cell In Range("F1:F" & lastrow)
Select Case cell.Value
Case Is = "Active"
cell.EntireRow.Interior.ColorIndex = 10
Case Is = "Status"
cell.EntireRow.Interior.ColorIndex = 15
Case Is = ""
cell.EntireRow.Interior.ColorIndex = 2
cell.EntireRow.Hidden = True
Case Else
cell.EntireRow.Interior.ColorIndex = 6
End Select
Next cell
Application.ScreenUpdating = True
End Sub
Here's a screenshot of some sample data:
You need to set the row height to zero to hide it
cell.EntireRow.RowHeight = 0
But don't forget to reset it in the other two cases
cell.EntireRow.AutoFit
Please check to see if the cell value is NULL as well as ""
This is a question about whether or not it is possible to do what I'm looking to do in excel. I have a caselist sheet that looks like this:
And an encounter form that looks like this:
On the Encounter Sheet, I want to make a dropdown list that only contains names of people assigned to a specific case manager. So, if I enter SH in the CM column, only those cases from the Caselist sheet where 'Assigned CM' is SH will populate the drop down menu.
Is this possible to do in Excel? Thanks for the assistance.
You may try the code given below.
The code assumes that you have two sheets in the workbook called "Encounter" and "CaseList". Headers on both the sheets are in row1. On Encounter Sheet, column A contains CM (a drop down to choose CM) and column B will have a dependent drop down list inserted by the code to choose the Names depending on the selected CM in col. A. On CaseList Sheet, Col. A is First Name, Col. B is Last Name and col. C is CM.
When above mentioned all the conditions are met, place the code given below on Encounter Sheet Module. To do so, right click on Encounter Tab --> View Code and place the code given below into the opened code window --> Close the VB Editor --> Save your workbook as Macro-Enabled Workbook.
So after selecting a CM in col. A on Encounter Sheet as soon as you select the corresponding cell in col. B, the code will create a data validation list in that cell so you can choose the first name and last name separated by a space from the list. And once you select an item, the first name and last name will be entered in the cell separate by a comma.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim sws As Worksheet
Dim lr As Long, n As Long, i As Long
Dim x, dict
Application.ScreenUpdating = False
Set sws = Sheets("CaseList")
lr = sws.Cells(Rows.Count, "C").End(xlUp).Row
x = sws.Range("A2:C" & lr).Value
If Target.Column = 2 And Target.Row > 1 Then
On Error Resume Next
n = Target.Offset(0, -1).Validation.Type
If n = 3 Then
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(x, 1)
If x(i, 3) = Target.Offset(0, -1).Value Then
dict.Item(x(i, 1) & " " & x(i, 2)) = ""
End If
Next i
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(dict.keys, ",")
End With
End If
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Target.Column = 2 And Target.Row > 1 Then
If Target <> "" Then
Application.EnableEvents = False
Target = WorksheetFunction.Substitute(Target.Value, " ", ", ", 1)
Application.EnableEvents = True
End If
End If
End Sub