I'm looking for hidding columns according to a cell value.
For exemple when the value is 1 the I to BV columns have to be hide. When value is 2 O to BV columns have to be hidding but the I to O columns have to be visible.
My code works only for 1 and I don't find how can I do...
Thank you for your help
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 1 Then
Columns("I:BV").EntireColumn.Hidden = True
Else: Columns("I:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change2(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 2 Then
Columns("O:BV").EntireColumn.Hidden = True
Else: Columns("O:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change3(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 4 Then
Columns("U:BV").EntireColumn.Hidden = True
Else: Columns("U:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change4(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 5 Then
Columns("AA:BV").EntireColumn.Hidden = True
Else: Columns("AA:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change5(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 6 Then
Columns("AG:BV").EntireColumn.Hidden = True
Else: Columns("AG:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change6(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 7 Then
Columns("AM:BV").EntireColumn.Hidden = True
Else: Columns("AM:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change7(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 8 Then
Columns("AS:BV").EntireColumn.Hidden = True
Else: Columns("AS:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change8(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 9 Then
Columns("AY:BV").EntireColumn.Hidden = True
Else: Columns("AY:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change9(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 10 Then
Columns("BE:BV").EntireColumn.Hidden = True
Else: Columns("BE:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change10(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 11 Then
Columns("BK:BV").EntireColumn.Hidden = True
Else: Columns("BK:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change11(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target = 12 Then
Columns("BQ:BV").EntireColumn.Hidden = True
Else: Columns("BQ:BV").EntireColumn.Hidden = False
End If
End If
End Sub
Just calculate whether the column number is greater than the last column which you want to be visible:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Dim i As Long
Dim lastVisible As Long
'Use cell B2 in the calculation, just in case Target is
' something like A1:D17
lastVisible = 2 + Range("B2").Value * 6
'That formula is calculating lastVisible such that:
'If B2 is 1, lastVisible will be 8 (i.e. column H)
'If B2 is 2, lastVisible will be 14 (i.e. column N)
'If B2 is 3, lastVisible will be 20 (i.e. column T)
'If B2 is 4, lastVisible will be 26 (i.e. column Z)
'... etc, up to
'If B2 is 11, lastVisible will be 68 (i.e. column BP)
'If B2 is 12, lastVisible will be 74 (i.e. column BV)
For i = 3 To 74
Columns(i).Hidden = i > lastVisible
Next
End If
End Sub
One change event with multiple conditions tests within an IF statement, using ElseIf. Without writing it all for you, the following it the structure and key elements. There are plenty of examples on stack overflow to help.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
'Code to unhide all columns goes here.
'Then test the contents of B2
If Target = 1 Then
Columns("I:BV").EntireColumn.Hidden = True
ElseIf Target = 2 Then
Columns("O:BV").EntireColumn.Hidden = True
ElseIf Target = 3 Then ......'Continue with rest of conditions
End If
End If
End Sub
You can do this in fewer lines:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim primaryCols As Range
If Not Intersect(Target, Range("B2")) Is Nothing Then
Range(Columns(3 + Range("B2").Value * 6), Columns(74)).EntireColumn.Hidden = False
Range(Columns(9), Columns(2 + Range("B2").Value * 6)).EntireColumn.Hidden = True
End If
End Sub
Basically it uses a little arithmetic to get your start column for those you want visible, and end column for those to hide, from column I onward.
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 am looking for way to keep a formula in a cell every time another cell is active.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Range("AL2").Value = 1 Then
ActiveSheet.Range("AK14").Value = ActiveSheet.Range("AL8").Value
Else
End If
End Sub
So if Cell AL2 is equal to 1 (so my desired active cell) I want to have a certain value in cell AK14.
If cell AL2 is NOT equal to 1 I want to just keep value in AK14 unchanged (so for example somebody can overwrite it).
At the moment Excel seems to get lost with the second part: if AL2 = 0 and I am getting an error.
If I need two conditions, do I just put another If?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("AL2").Value = 1 Then Range("F11").Value = Range("AK7").Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("AL2").Value = 2 Then Range("J11").Value = Range("AL7").Value
Application.EnableEvents = True
End Sub
so I want to have those two macros..
When you change value in a cell, in a Worksheet_Change event, you should disable the events. Otherwise, it starts calling itself:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("AL2").Value = 1 Then Range("AK14").Value = Range("AL8").Value
Application.EnableEvents = True
End Sub
Then, as a next step it is really a good practice to use Error-catcher here with the .EnableEvents:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Worksheet_Change_Error
Application.EnableEvents = False
If Range("AL2").Value = 1 Then Range("AK14").Value = Range("AL8").Value
Application.EnableEvents = True
On Error GoTo 0
Exit Sub
Worksheet_Change_Error:
Debug.Print "Error " & Err.Number & " (" & Err.Description & ") "
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 have excel sheet with dropdown list and when I choose anything from the list
macro will vlookup for requested value. But when I want to remove values from those cells, that I select them and press delete, it will show me "#N/A" and the excel is frozen, I cant do anything. Could you advise me, how can I avoid it, please?
Option Explicit
Private Sub Worksheet_Change()
Dim Target As Range
Dim selectedNa As Integer, selectedNum As Integer
selectedNa = Target.Value
If Target.Column = 10 Then
selectedNum = Application.VLookup(selectedNa, ActiveSheet.Range("dropdown"), 2, False)
If Not IsError(selectedNum) Then
Target.Value = selectedNum
Else: Exit Sub
End If
Else: Exit Sub
End If
End Sub
Try the following:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim selectedNa As Long, selectedNum As Variant
If Target.Column = 10 And Not IsEmpty(Target) Then 'selectedNa <> vbNullString Then '
Application.EnableEvents = False
On Error GoTo errhand
selectedNa = Target.Value
selectedNum = Application.VLookup(selectedNa, ActiveSheet.Range("dropdown"), 2, False)
If Not IsError(selectedNum) Then
Target.Value = selectedNum
End If
Application.EnableEvents = True
End If
Exit Sub
errhand:
If Err.Number <> 0 Then
Application.EnableEvents = True
End If
End Sub
Change your posted code to
Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)
Dim selectedNa As Integer, selectedNum As Integer
On Error GoTo EH
Application.EnableEvents = False
selectedNa = target.Value
If target.Column = 10 Then
selectedNum = Application.VLookup(selectedNa, ActiveSheet.Range("dropdown"), 2, False)
If Not IsError(selectedNum) Then
target.Value = selectedNum
End If
End If
EH:
Application.EnableEvents = True
Debug.Print Err.Number, Err.Description
End Sub
The code HAS TO be put into the sheet module.
Have a look at the immediate window after you have changed or deleted a value in your sheet.
It looks like this is what you want, based on the information provided:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CheckCells As Range
Dim ChangedCell As Range
Set CheckCells = Intersect(Me.Columns(10), Target)
Application.EnableEvents = False
If Not CheckCells Is Nothing Then
For Each ChangedCell In CheckCells.Cells
If Len(ChangedCell.Value) > 0 And WorksheetFunction.CountIf(Me.Range("dropdown"), ChangedCell.Value) > 0 Then
ChangedCell.Value = WorksheetFunction.VLookup(ChangedCell.Value, Me.Range("dropdown").Resize(, 2), 2, False)
End If
Next ChangedCell
End If
Application.EnableEvents = True
End Sub
Option Explicit
Public PlotName As String
Public PlotRange As Range
Sub Tester()
Range("TCKWH.V.1").Select
AddPlot ActiveSheet.Range("KWH_G_1")
End Sub
Sub AddPlot(rng As Range)
With ActiveSheet.Shapes.AddChart
PlotName = .Name
.Chart.ChartType = xlLineMarkers
.Chart.SetSourceData Source:=Range(rng.Address())
.Chart.HasTitle = True
.Chart.ChartTitle.Text = Range("KWH.G.1")
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range("KWH.G.1")
End With
Set PlotRange = rng
Application.EnableEvents = False
rng.Select
Application.EnableEvents = True
End Sub
Sub FixPlott(rng As Range)
Dim n As Long
With ActiveSheet.Shapes(PlotName)
For n = .SeriesCollection.Count To 1 Step -1
With .SeriesCollection(n)
If PlotName = "" Then
.Delete
End If
End With
Next n
End With
End Sub
Sub RemovePlot(rng As Range)
If Not PlotRange Is Nothing Then
If Application.Intersect(rng, PlotRange) Is Nothing Then
On Error Resume Next
rng.Parent.Shapes(PlotName).Delete
On Error GoTo 0
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
RemovePlot Target
Application.ScreenUpdating = True
End Sub
I need help with Sub FixPlott. I am trying to get it to delete the Legend Entries on the Legend Key. For example if I select Main Campus and South Hall there will be blank legend entries for dunblane and greensburg. Id like the legend just to show selected buildings.
Here you have a corrected version of your sub:
Sub FixPlott(PlotName As String)
Dim n As Long
With ActiveSheet.Shapes(PlotName).Chart
For n = .SeriesCollection.Count To 1 Step -1
With .SeriesCollection(n)
If .Name = "" Then
ActiveSheet.Shapes(PlotName).Chart.Legend.LegendEntries(n).Delete
End If
End With
Next n
End With
End Sub
I am not sure about the exact trigger you want to use. So I have included a simple string trigger; if the given SeriesCollection is called like trigger, the legend will be deleted.