VBA, If active cell in range does not equal a String call Macro - excel

I am very new to the World of VBA. I am attempting to add to an existing Private Sub(Change). I am trying to "fire" the Macro "DelRCE" When the Active Cell in Range("K2:K700") Does Not equal the word "Down".
The code below is not working:
Dim txt As String
Dim rng As Range
Dim vec As String
txt = ActiveCell.Value
rng = ("K2:K700")
vec = "Down"
If r_ng.txt <> vec Then
Call Macro
End If

I assume you are looking for something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim key As String
Dim rng As Range
'Set the word you want to search for. Take capital letters into account
key = "down"
'Set worksheet to the first sheet in your workbook
Set ws = ThisWorkbook.Sheets(1)
'Change this to the range you want to search
Set rng = ws.Range("A1:A100")
'Check if the target is in the range
If Not Intersect(Target, rng) Is Nothing Then
If Target.Value <> key Then
'Change this to you function call
MsgBox "The target is inside the range and the value is different from '" & key & "'"
End If
End If
End Sub

Put the cursor inside the test_Change sub and hit PF5 to run it.
private Sub Change()
Dim txt As String
Dim rng As Range
Dim vec As String
txt = ActiveCell.Value
rng = ("K2:K700")
vec = "Down"
If r_ng.txt <> vec Then
Call DelRCE ' or "Run DelRCE" if it is a function
End If
End Sub
Private Sub test_Change()
call Change
End Sub

Add the code below to the relevent Worksheet module, under the Worksheet_Change event:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vec As String
vec = "Down"
If Not Intersect(Target, Range("K2:K700")) Is Nothing Then ' check that modifed cell is inside the Range("K2:K700")
If Target.Count > 1 Then Exit Sub ' Optional : if more than 1 cell selected exut the sub
If Not Target.Value Like vec Then ' Also possible to use: If Target.Value <> vec
Call Macro
End If
End If
End Sub

Related

Name of cells in vba across sheets

Can someone help me with the following scenario:
If A1 in sheet1 is equal to "W1" how do I make a VBA so B2 in sheet2 is equal to "Goodmorning Monday".
I have to make so if A1 in Sheet1 is changed to "W2" then B2 in sheet2 is equal to "Goodmorning Tuesday".
I have tried the following code:
Sub Datesss()
If Sheets("Sheet1").Range("A1") = "W1" Then
Sheets("Sheet2").Range("B2") = "Goodmorning Monday"
or
If Sheets("Sheet1").Range("A1") = "W2" Then
Sheets("Sheet2").Range("B2") = "Goodmorning Tuesday"
End Sub
A Worksheet Change: As Simple As It Gets
Copy the following code to the sheet code module of worksheet Sheet1. In the VBE Project Explorer, the name not in parentheses is the sheet code name which will also be displayed in the window in VBA, while the name in parentheses is the tab name.
There is nothing to run, it runs automatically.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WDays(): WDays = VBA.Array("W1", "W2", "W3", "W4", "W5", "W6", "W7")
Dim Days(): Days = VBA.Array("Monday", "Tuesday", "Wednesday", _
"Thursday", "Friday", "Saturday", "Sunday") _
Dim sws As Worksheet: Set sws = Me ' worksheet containing this code
Dim sCell As Range: Set sCell = sws.Range("A1")
Dim tCell As Range: Set tCell = Intersect(sCell, Target)
If tCell Is Nothing Then Exit Sub
Dim tValue As Variant: tValue = tCell.Value
Dim tIndex As Variant: tIndex = Application.Match(tValue, WDays, 0)
If IsError(tIndex) Then Exit Sub
Dim dws As Worksheet: Set dws = sws.Parent.Sheets("Sheet2")
Dim dCell As Range: Set dCell = dws.Range("B2")
dCell.Value = "Good Morning " & Days(tIndex - 1)
End Sub
Please, copy the next code in "Sheet1" code module:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.address(0, 0) = "A1" Then
Dim sh2 As Worksheet: Set sh2 = Worksheets("Sheet2")
If Target.Value Like "W?" Then
If CLng(Mid(Target.Value, 2)) > 0 And CLng(Mid(Target.Value, 2)) <= 7 Then
sh2.Range("B2").Value = "Goodmorning " & getDayName(Mid(Target.Value, 2)) 'Monday"
End If
End If
End If
End Sub
Function getDayName(dayNo As Long) As String
Dim arrDaysName: arrDaysName = Split("Monday,Tuesday,Wednesday,Thurstay,Friday,Saturday,Sunday", ",")
getDayName = arrDaysName(CLng(dayNo))
End Function
Change "A1" cell content and check what happens in "Sheet2", "B2" cell...
Of course, it will do something only for suffix numbers between 1 and 7...
You can use the built in functions in Code behind sheet.
Goto your VBA projects (Alt+F11), and then open the Project Explorer (Ctrl+R)
Double Click Sheet1 and code area will show. Then paste this code in:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Worksheets("Sheet2").Cells(2, 2) = "Goodmorning Monday"
End If
End Sub
Whenever any Cell in Sheet1 is changed this code runs. And by checking the Target. Address you can manipulate what ever you want. Remember to save your file as .xlsm ;-)

automatic static date and time when a value was copied from another worksheet and pasted to a sheet with macro

I am working on a worksheet that will enter static date and time in an excel worksheet when a value is typed in a target cell. However, the worksheet will be used where values are copied from a downloaded file and pasted to the macro worksheet. When values are typed, the date and time worked as expected but if values are pasted, the VBA code does not work, it has to be typed. How can I make that possible?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C2:C100")) Is Nothing Then
With Target(1, -1)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
Something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
'any updates to C2:C100 ?
Set rng = Application.Intersect(Target, Me.Range("C2:C100"))
If Not rng Is Nothing Then
'loop over all updated cells
For Each c In rng.Cells
c.Offset(0, -2).Value = Date
Next c
rng.Offset(0, -2).EntireColumn.AutoFit
End If
End Sub
Add Date Stamp on Cell Change
Pick one.
Easy
Private Sub Worksheet_Change(ByVal Target As Range)
Const cFirst As String = "C2"
Const dCol As String = "A"
Dim rg As Range
Set rg = Range(cFirst).Resize(Rows.Count - Range(cFirst).Row + 1)
Set rg = Intersect(Target, rg)
If Not rg Is Nothing Then
' Since you cannot manually paste a non-contiguous range
' (you can copy one), you can get away with the following line:
rg.EntireRow.Columns(dCol).Value = Date
rg.EntireColumn.AutoFit
End If
End Sub
Hard
Private Sub Worksheet_Change(ByVal Target As Range)
Const cFirst As String = "C2"
Const dCol As String = "A"
' Create a reference to the column range from 'cFirst'
' to the bottom-most cell in the worksheet.
Dim rg As Range: Set rg = Intersect(Target, _
Range(cFirst).Resize(Rows.Count - Range(cFirst).Row + 1))
If rg Is Nothing Then Exit Sub
' If you plan to populate the cells via VBA, then you could write
' non-contiguously to the column range,
' e.g. with 'Range("C3,C5:C7,C10:20").value = 1'.
' Then you could use the following:
Dim dDate As Date: dDate = Date
Dim arg As Range
For Each arg In rg.Areas
arg.EntireRow.Columns(dCol).Value = dDate
Next arg
rg.EntireColumn.AutoFit
End Sub
Tough
Private Sub Worksheet_Change(ByVal Target As Range)
addDateStamp Target, "C2", "A"
End Sub
' This is usually, but not necessarily, located in a standard module.
Sub addDateStamp( _
ByVal TargetRange As Range, _
ByVal FirstCellAddress As String, _
ByVal DateStampColumn As String)
If Not TargetRange Is Nothing Then
Dim rg As Range
With TargetRange.Worksheet.Range(FirstCellAddress)
Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1)
End With
Set rg = Intersect(TargetRange, rg)
If Not rg Is Nothing Then
Dim dDate As Date: dDate = Date
Dim arg As Range
For Each arg In rg.Areas
arg.EntireRow.Columns(DateStampColumn).Value = dDate
Next arg
rg.EntireColumn.AutoFit
End If
End If
End Sub

Select Item in Pivot Slicer when A1 Value Changes

I'm trying to select an item in Pivot Slicer when I change "A1" value.
So when I change the "A1" value to "ABC" the code should look for "ABC" in the Slicer Item and select it.
"A1" value will be same as the items in the slicer.
Here is my try, but doesn't seems to work and doesn't look right :(
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim i As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
If Not Intersect(Target, Range("A1")) Is Nothing Then
For i = 1 To ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems.Count
If ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems(i).Value = ActiveSheet.Range("A1") Then
ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems(i).Selected = True
Else
ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems(i).Selected = False
End If
Next
End If
End Sub
Thank you in advance.
I was able to find something that would works.
This is not perfect but works, but still looking for a better way to do this.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
If Not Intersect(Target, Range("A1")) Is Nothing Then
ActiveWorkbook.SlicerCaches("Slicer_Test").Slicers(1).SlicerCache.ClearAllFilters
For i = 1 To ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems.Count
If ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems(i).Value <> ActiveSheet.Range("A1") Then
ActiveWorkbook.SlicerCaches("Slicer_Test").SlicerItems(i).Selected = False
End If
Next
End If
End Sub

worksheet change event only works when region selected - how to adjust to automatic update

the combination of this sub in a module
Sub hithere3()
Dim Rng As Range
Dim Unique As Boolean
For Each Rng In Worksheets("Sheet8").Range("FS3:FS30") 'for each cell in your B1 to B30 range, sheet1
Unique = True 'we'll assume it's unique
Lastunique = Worksheets("TRADES").Range("C:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 3 To Lastunique 'for each cell in the unique ID cache
If Rng.Value = Worksheets("TRADES").Cells(i, 3).Value Then 'we check if it is equal
Unique = False 'if yes, it is not unique
End If
Next
If Unique Then Worksheets("TRADES").Cells(Lastunique + 1, 3) = Rng 'adds if it is unique
Next
End Sub
with the loop check in a worksheet change events
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub
works except it only updates when I select one of the cells in FS3:FS33
Can anyone suggest how this can be overcome?
maybe with a workchange change range selection type from below?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, n As Long
Dim RngB As Range, RngC As Range
If Target.Column = 2 And Target.Count = 1 And Target.Row > 1 Then
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Set RngB = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set RngC = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
ray = Array(RngB, RngC)
For n = 0 To 1
For Each Dn In ray(n)
If Not Dn.Address(0, 0) = "C1" And Not Dn.Value = "" Then
.Item(Dn.Value) = Empty
End If
Next Dn
Next n
Range("C2").Resize(.Count) = Application.Transpose(.Keys)
End With
End If
Use either the worksheet Calculate event or the worksheet Change event:
use Calculate if the range contains formulas
use Change if the cells in the range are changed manually
If Intersect(Target, Range("FS3:FS33")) Is Nothing is the culprit. You must change Range("FS3:FS33") to whatever range you want to affect this change.
Private Sub Worksheet_Change(ByVal Target As Range) '<<delete the "Selection" from the name of event
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub
Finally figured it out, the following code works :
Private Sub Worksheet_calculate()
If Range("FS3:FS33") Is Nothing Then
'Do nothing'
Else
Call hithere3
End If
End Sub

Macro that automatically formats cell when value is entered. (convert macro to the event macro?)

I've got a spreadsheet, where I'd like A:A range to be formatted automatically so that characters will show in red and digits stay the same color. The following macro seems to work OK, but I need to manually run it every time I change value in the cell:
Sub Red_text()
Dim i As Integer
Dim MyString As String
MyString = ActiveCell.Value
For i = 1 To Len(MyString)
If IsNumeric(Mid(MyString, i, 1)) = False Then
ActiveCell.Characters(i, 1).Font.Color = RGB(247, 66, 66)
End If
Next i
End Sub
So basically I need to change it into an event macro that will reformat the current cell every time it is edited. And limit this behavior to A:A range.
Any help would be greatly appreciated!!
First a slight change to your macro:
Sub Red_text(r As Range)
Dim i As Integer
Dim MyString As String
MyString = r.Value
For i = 1 To Len(MyString)
If IsNumeric(Mid(MyString, i, 1)) = False Then
r.Characters(i, 1).Font.Color = RGB(247, 66, 66)
End If
Next i
End Sub
and also include the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Range("A:A")
If Intersect(A, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
Call Red_text(Target)
Application.EnableEvents = True
End Sub
The event macro detects entries to column A and then applies formatting.
EDIT#1:
The event macro must change to handle more than one cell at a time. Remove the original event macro and use this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, rBIG As Range, r As Range
Set A = Range("A:A")
Set rBIG = Intersect(A, Target)
If rBIG Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In rBIG
Call Red_text(r)
Next r
Application.EnableEvents = True
End Sub

Resources