I want to select a range (B2) resulting from the dropdown referring from another range (source from F2: F5). I mean I do not need to change the values in the macro code if one day I had to change the data in the reference range (F2: F5). If the value in the range B2 is equal to the value of the text on one of the list range F2: F5 then the macro will run.
I want something like this:
Private Sub Worksheet_Calculate(ByVal Target As Range)
If Target.Address = "$B$2" Then
If Range("B2").Value = Range("F3").Value Then
Rows("10:20").EntireRow.Hidden = False
Rows("11:21").EntireRow.Hidden = True
ElseIf Range("B2").Value = Range("F4").Value Then
Rows("10:20").EntireRow.Hidden = True
Rows("11:21").EntireRow.Hidden = False
..............
..............
..............
End If
End If
End Sub
How can I re-write this logic in a way that is VBA friendly? Thanks for your help
You'll want to use a Worksheet_Change... This activates on any changes to the sheet. (Put this code in the SHEET's CODE). First it checks to make sure the cell is B2 then it checks to make sure B2's Value is found in your reference cells. Then it does a Select Case for each possible option.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2")) is Nothing Then
Exit Sub
End If
Select Case Range("B2").Value
Case Range("F2").Value
'Do Something
Case Range("F3").Value
'Do Something
Case Range("F4").Value
'Do Something
Case Range("F5").Value
'Do Something
Case Else
Exit Sub
End Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address = "$B$2" Then
Application.EnableEvents = False
Select Case .Value
Case Range("F3").Value
Rows("10:20").EntireRow.Hidden = False
Rows("11:21").EntireRow.Hidden = True
Case Range("F4").Value
Rows("10:20").EntireRow.Hidden = True
Rows("11:21").EntireRow.Hidden = False
End Select
Application.EnableEvents = True
End If
End With
End Sub
Why do you not use the Select case structure:
Private Sub Worksheet_Calculate(ByVal Target As Range)
If Target.Address = "$B$2" Then
Select Case Range("B2").Value
case Range("F3").Value
Rows("10:20").EntireRow.Hidden = False
Rows("11:21").EntireRow.Hidden = True
case Range("B2").Value = Range("F4").Value Then
Rows("10:20").EntireRow.Hidden = True
Rows("11:21").EntireRow.Hidden = False
..............
..............
..............
End Select
End If
End Sub
Related
I was trying to code in VBA to enable or disable the checkboxes for the mobile plan based on the brand selected as shown in the image.
The table on the left acts as an indicator of the availability of the mobile plans for the respective brands as indicated by "Y" or "N". For example, when the user selected "Apple" from the dropdown list, he is only allowed to tick the Mobile Plan 1.
The attempted solution is based on only one criteria, which is for "Apple" in this case. How do I enhance the coding so that when the user selects "Samsung", the status of the checkboxes will change accordingly?
I planned to declare a variable as an Integer to act as an column indicator (for eg, Apple = 2, Samsung = 3, Nokia = 4) and pass this integer to the each function "CheckBox_Change" and use the VLOOKUP function, but I get an error message:
"procedure declaration does not match description of event or
procedure having the same name"
while I was trying to do so.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
Call CheckBox1_Change
Call CheckBox2_Change
Call CheckBox3_Change
End If
End Sub
Private Sub CheckBox1_Change()
If Range("B3").Value = "Y" Then
CheckBox1.Enabled = True
Else
CheckBox1.Enabled = False
CheckBox1.Value = False
End If
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = False Then
Range("H3").Value = ""
End If
End Sub
Private Sub CheckBox2_Change()
If Range("B4").Value = "Y" Then
CheckBox2.Enabled = True
Else
CheckBox2.Enabled = False
CheckBox2.Value = False
End If
End Sub
Private Sub CheckBox3_Change()
If Range("B5").Value = "Y" Then
CheckBox3.Enabled = True
Else
CheckBox3.Enabled = False
CheckBox3.Value = False
End If
End Sub
I'd go this way (explanations in comments):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
With Range("B2:D2").Find(Target.Value, , xlValues, xlWhole) ' reference the cell with the proper Brand
CheckBox1.Enabled = .Offset(1).Value = "Y" 'set checkbox visibility to match referenced cell column corresponding value
CheckBox2.Enabled = .Offset(2).Value = "Y" ' same as above
CheckBox3.Enabled = .Offset(3).Value = "Y" ' same as above
End With
End If
End Sub
you could also loop between checkboxes "indexes" and avoid some code duplication:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
Dim i As Long
With Range("B2:D2").Find(Target.Value, , xlValues, xlWhole) ' reference the cell with the proper Brand
For i = 1 To 3 ' loop from 1 to 3 (number of checkboxes)
Me.OLEObjects("CheckBox" & i).Enabled = .Offset(i).Value = "Y" 'set current checkbox visibility to match referenced cell column corresponding value
Next
End With
End If
End Sub
Basing on #QHarr's answer, you can reduce the code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "G1" Then
Me.CheckBox1.Enabled = (Target = "Apple")
Me.CheckBox2.Enabled = (Target = "Samsung")
Me.CheckBox3.Enabled = (Target = "Samsung")
End If
End Sub
Try the following. It uses Select Case to avoid repeating sections of code and having multiple subs.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "G1" Then
Select Case Target.Value
Case "Apple"
Me.CheckBox1.Enabled = True
Me.CheckBox2.Enabled = False
Me.CheckBox3.Enabled = False
Case "Samsung"
Me.CheckBox1.Enabled = False
Me.CheckBox2.Enabled = True
Me.CheckBox3.Enabled = True
Case Else
Me.CheckBox1.Enabled = False
Me.CheckBox2.Enabled = False
Me.CheckBox3.Enabled = False
End Select
End If
End Sub
I have created a form that will give the user the choice to pick from 7 different options which will all be default blank. When they click the cell next to the option it will change from blank to "yes" and when clicked again it will remove the text and so on. Cells R33 and S33 are merged and the code works fine there but i need the code to run across multipe cells that are also merged such as (R35-S35, R37-S37, R39-S39 & R41-S41.
Can you help me out with this please?
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("R33").MergeArea) Is Nothing Then
Select Case True
Case Target.Cells(1) = "yes"
Target.Cells(1) = ""
Case Target.Cells(1) = ""
Target.Cells(1) = "yes"
End Select
Range("A1").Select
End If
Application.EnableEvents = True
End Sub
You can select multiple cells and that should be accounted for. A static union of the merge areas will not have to be redefined on every selection.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
static mrng as range
if mrng is nothing then
set mrng = union(cells(33, "R").mergearea, cells(35, "R").mergearea, _
cells(37, "R").mergearea, cells(39, "R").mergearea, _
cells(41, "R").mergearea)
end if
If Not Intersect(Target, mrng) Is Nothing Then
Application.EnableEvents = False
dim t as range
for each t in Intersect(Target, mrng)
select case lcase(t.value2)
case "yes"
t = vbnullstring
case else
t = "Yes"
end select
next t
Range("A1").Select
End If
Application.EnableEvents = True
End Sub
I have basic code that allows the values written to this cell to be summed while maintaining the cumulative value. So if I were to type "4" into the cell, and then type "10" into the cell, the result would be "14" (not just the second value entered of "10"). Here is what I have and I must say that it works.
#
Option Explicit
Dim oldvalue As Double
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$J$5" Then
On Error GoTo fixit
Application.EnableEvents = False
If Target.Value = 0 Then oldvalue = 0
Target.Value = 1 * Target.Value + oldvalue
oldvalue = Target.Value
fixit:
Application.EnableEvents = True
End If
End Sub
#
However, I want to apply this treatment to more than just cell J5. Say for example, I want the same code logic applied to cell R5 as well.
Thur far I have tried using
OR
and I have also tried using
If Not Intersect (Target, Range("J5:R5")) Is Nothing Then
But each of these approaches ties the two cells together (so that what I enter into one gets summed into both - each cell is summing values added to the other). I can't figure it out to save my life, so took to this forum in the hopes of finding someone smarter than me.
Maybe (this is assuming existing logic is correct....not sure why you set old value to 0 if Target = 0 and what value the *1 adds?)
Option Explicit
Dim oldvalueJ As Double
Dim oldValueR As Double
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo fixit
Application.EnableEvents = False
Select Case Target.Address
Case "$J$5"
If Target = 0 Then oldvalueJ = 0
Target = Target + oldvalueJ
oldvalueJ = Target
Case "$R$5"
If Target = 0 Then oldValueR = 0
Target = Target + oldValueR
oldValueR = Target
End Select
fixit:
Application.EnableEvents = True
End Sub
This is a bit more dynamic by allowing you to add unlimited cells; it also validates user input
Standard Module
Option Explicit 'Generic Module
Public Const WS1_MEM_RNG = "C5,J5,R5" 'Sheet1 memory cells
Public prevWs1Vals As Object
Public Sub SetPreviousWS1Vals()
Dim c As Range
For Each c In Sheet1.Range(WS1_MEM_RNG).Cells
If Len(c.Value2) > 0 Then prevWs1Vals(c.Address) = c.Value2
Next
End Sub
Sheet1 Module
Option Explicit 'Sheet1 Module
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.CountLarge = 1 Then
If Not Intersect(Target, Me.Range(WS1_MEM_RNG)) Is Nothing Then GetPrevious Target
End If
End Sub
Private Sub GetPrevious(ByVal cel As Range)
Dim adr As String: adr = cel.Address
Application.EnableEvents = False
If Not IsError(cel.Value) And IsNumeric(cel.Value2) And Not IsNull(cel.Value) Then
If IsDate(cel.Value) Then
cel.NumberFormat = "General"
cel.Value2 = prevWs1Vals(adr)
Else
If cel.Value2 = 0 Then prevWs1Vals(adr) = 0
cel.Value2 = cel.Value2 + prevWs1Vals(adr)
prevWs1Vals(adr) = cel.Value2
End If
Else
cel.Value2 = prevWs1Vals(adr)
End If
Application.EnableEvents = True
End Sub
ThisWorkbook Module
Option Explicit 'ThisWorkbook Module
Private Sub Workbook_Open()
If prevWs1Vals Is Nothing Then Set prevWs1Vals = CreateObject("Scripting.Dictionary")
SetPreviousWS1Vals
End Sub
It can also enforce positives only
use commas to separate ranges, and add a Worksheet_SelectionChange() event to record the last user selected cell
Option Explicit
Dim oldvalue As String
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("J5,R5")) Is Nothing Then Exit Sub
If Target.Value = 0 Then Exit Sub
On Error GoTo fixit
Application.EnableEvents = False
Target.Value = Target.Value + oldvalue
fixit:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge = 1 Then oldvalue = Target.Value
End Sub
I want to lock cell B20 and write "1" on it if I choose a certain option ("T") on the dropdown of B18. If I choose any other option, I want to be able to fill it normally without any limitations. Here is the best code I tried:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ActiveSheet
If Target.Address = "$B$18" Then
ws.Unprotect
Application.EnableEvents = False
Target.Offset(1).Locked = Target.Value = "T"
If Target.Value = "T" Then
Target.Offset(1).Value = 1
Else
If Target.Offset(1).Value = 1 Then Target.Offset.Value = ""
End If
Application.EnableEvents = True
ws.Protect
End If
End Sub
This code is doing exactly what I want but its performing this on the cell B19 instead of B20.
Can somebody help me please?
There is a bunch of code and text all saying different things in your question, so I based this code on your comment and the text of your question.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$18" Then
ws.Unprotect
Application.EnableEvents = False
Target.Offset(2).Locked = Target.Value = "T"
If Target.Value = "T" Then
Target.Offset(2).Value = 1
Else
If Target.Offset(2).Value = 1 Then Target.Offset.Value = ""
End If
Application.EnableEvents = True
ws.Protect
End If
End Sub
I am trying to setup a vba code so I will be able to click on a specific number of cells and have these cells switch between "nothing", "cr" & "cv". So far I have this in my code but I need to assign it to multiple targets but I can't seem to get them to work independently.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
With Target
If .Address = Range("A1").Address Then
Select Case .Value
Case ""
.Value = "CR"
Case "CR"
.Value = "CV"
Case "CV"
.Value = ""
Case Else
.Value = "CR"
End Select
End If
End With
Range("A2").Select
Application.EnableEvents = True
End Sub
This would be one way of achieving what you want.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 07 May 2017
Dim Rng As Range
Set Rng = Range("A1,B2:B4,C3,D4")
If Not Application.Intersect(Target, Rng) Is Nothing Then
MsgBox "Cell " & Target.Address(False, False) & " was clicked."
End If
End Sub
I observed that your first Select statement is superfluous because it is identical with the last. :-)
Mapleleaf,
I'm not altogether sure that I understand completely what you're after, but this worked for me:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
For Each T In Target
With T
'If .Address = Range("A1").Address Then
Select Case .Value
Case ""
.Value = "CR"
Case "CR"
.Value = "CV"
Case "CV"
.Value = ""
Case Else
.Value = "CR"
End Select
'End If
End With
Next
Range("A2").Select
Application.EnableEvents = True
End Sub
If this turns out not to be what you were trying to accomplish, I suspect you'll be able to easily adapt it to do what you need. Hope this helps. If you have any questions, don't hesitate.
This is what I came up with and it works great. Thank you for your help.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Cells.Count = 1 Then
If Not Intersect(Target, Range("C8:C10:C12:C14:C16:I8:I10:I12:I14:I16:O8:O10:O1:O14:O16:U8:U10:U12:U14:U16:AA8:AA10:AA12:AA14:AA16:AG8:AG10:AG12:AG14:AG16:AM8:AM10:AM12:AM14:AM16")) Is Nothing Then
Select Case Target.Value
Case ""
Target.Value = "CR"
Case "CR"
Target.Value = "CV"
Case "CV"
Target.Value = ""
Case Else
Target.Value = "CR"
End Select
Range("B2").Select
End If
End If
Application.EnableEvents = True
End Sub