Writing to multiple cells using If Target.Address = " " Then - vba

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

Related

VBA Macro triggering too often

My worksheet is set up with data validation dropdowns and I am wanting a macro to ONLY trigger when the value of the cell is changed from another value in the dropdown, not from the default "empty" value.
Here is what I am trying to use:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If IsEmpty(Target.Value) = True Then
MsgBox "Test1"
Else
MsgBox "Test2"
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
My problem is that this "IsEmpty" command is reading the cell AFTER the selection not before. I want it to read what the cells value was BEFORE the selection not after.
How can I do this?
Example approach:
Const COL_CHECK As Long = 5
Private oldVal
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Set c = Target.Cells(1) '<< in case multiple cells are changed...
If c.Column = COL_CHECK Then
If oldVal <> "" Then
Debug.Print "changed from non-blank"
Else
Debug.Print "changed from blank"
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Set c = Target.Cells(1)
oldVal = IIf(c.Column = COL_CHECK, c.Value, "")
Debug.Print "oldVal=" & oldVal
End Sub
Another approach:
This will need one cell per validation-dropdown:
Function ValChange(Cell2Follow As Range) As String
ValChange = ""
If Len(Application.Caller.Text) = 0 Then Exit Function
If Application.Caller.Text = Cell2Follow.Text Then Exit Function
MsgBox "value of the cell is changed from another value in the dropdown" & vbLf & "not from the default 'empty' value"
End Function
in a different cell, assumed the dropdown is in E6:
=E6&ValChange(E6)
application.caller.text will be the old value
(calculation must be automatic)

Keeping cell unchanged under specified conditions

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

When I remove data, code will stuck

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

Excel sheet: Lock cell and write "1" on it based on a dropdown option

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

How Hide columns according to a cell value

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.