When i click cell B1, an input box pops up, i put my value in and that value is then entered into cell B1. How do i make it so any cell within a range results in the same input box, and that value is inputted into the cell i clicked in that range, but on a different sheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRtn As Variant
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B1:C2")) Is Nothing Then
xRtn = Application.Inputbox("Insert your value please")
If xRtn <> False Then Target.Value = xRtn
End If
End If
End Sub
Example: Click cell B1 in sheet 1, input value 5, 5 is entered into cell B1 in sheet 2
Edit: i now have it inputting my value into sheet 2 but i have no idea how to make it input my value into only the specific cell i clicked, currently it inputs my value into all cells within the specified range in sheet 2
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRtn As Variant
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B1:C2")) Is Nothing Then
xRtn = Application.Inputbox("Insert your value please")
Sheets("Sheet2").Range("B1:C2").Value = xRtn
End If
End If
End Sub
Edit 2: solved it on my own having absolutely no clue what i was doing never touching code or vba before just trying random stuff
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRtn As Variant
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B1:C2")) Is Nothing Then
xRtn = Application.Inputbox("Insert your value please")
Sheets("Sheet2").Range(Target.Address).Value = xRtn
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRtn As Variant
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B1:C2")) Is Nothing Then
xRtn = Application.Inputbox("Insert your value please")
Sheets("Sheet2").Range(Target.Address).Value = xRtn
End If
End If
End Sub
Related
I have created a simple Excel Macro which is triggered when a user clicks on a cell in a worksheet (worksheet1). Basically the macro takes the value of the cell which was clicked on and selects a target cell in a separate worksheet (worksheet2) that has the same value.
The problem is that about 20% of the time after being directed to worksheet2, the target cell is highlighted but is just out of view, i have to scroll down a couple of rows to see it. I want to be able to ensure that the target cell is always in view after the user is directed to it, but I am not sure how this can be achieved.
This is in Excel 2016.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then
If Target.Cells.Count = 1 Then
Application.ScreenUpdating = False
Dim c As Range
Dim ans As String
Dim Lastrow As Long
ans = ActiveCell.Value
Lastrow = Sheets("worksheet2").Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Sheets("worksheet2").Range("A2:A" & Lastrow)
If c.Value = ans Then Application.Goto Reference:=Sheets("worksheet2").Range(c.Address): Exit Sub
Next
End If
End If
Exit Sub
End Sub
You can use find to find the selected item in sheet2 then just select the sheet and the found cell
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As Range
If Target.Column = 1 Then
Set s = Worksheets("Sheet2").Range("B:B").Find(what:=Target, lookat:=xlWhole)
If Not s Is Nothing Then
Worksheets("Sheet2").Activate
s.Select
Else: MsgBox Target.Value & " is not found in sheet 2"
End If
End If
End Sub
The below code works just great.
Now I only want it to function if cell B2 says "2020".
If cell B2 says "2021", for example, I want the value instead to go to sheet "2021".
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRtn As Variant
If Selection.Count = 1 Then
If Not Intersect(Target, Range("D9:AS20")) Is Nothing Then
xRtn = Application.InputBox("Insert your value please")
Sheets("2020").Range(Target.Address).Value = xRtn
End If
End If
End Sub
How can I achieve that?
solved myself
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRta As Variant
If Selection.Count = 1 Then
If ActiveSheet.Range("B2") = "2020" Then
If Not Intersect(Target, Range("D9:AS20")) Is Nothing Then
xRta = Application.InputBox("Insert your value please")
Sheets("2020").Range(Target.Address).Value = xRta
End If
End If
End If
Dim xRtb As Variant
If Selection.Count = 1 Then
If ActiveSheet.Range("B2") = "2021" Then
If Not Intersect(Target, Range("D9:AS20")) Is Nothing Then
xRtb = Application.InputBox("Insert your value please")
Sheets("2021").Range(Target.Address).Value = xRtb
End If
End If
End If
End Sub
I have an Excel spreadsheet where I want to protect cells in column I if the respective cell of column H <> "yes".
I found a code but it will protect all the cells of column I.
Option explicit
Sub unprotected
Me.unprotect password:= "abc"
End sub
Sub protect
Me.protect userinterfaceonly:= true ,password:= "abc"
End sub
Private Sub Worksheet_change(ByVal Target As Range)
Dim Crow as Long
Call Unprotected
xrow = Target.Row
If not (intersect(Target, range("H3:H1000")) is nothing then
Cells(xrow, "I").locked = (Ucase(trim(cells(xrow, "H").value))<>"yes")
End if
Call protect
End sub
Try this:
Option Explicit
Const PW As String = "abc" '<< use a constant for fixed/shared values
Private Sub Worksheet_change(ByVal Target As Range)
Dim rng As Range, c As Range
'find changed cells in range of interest
Set rng = Application.Intersect(Target, Me.Range("H3:H1000"))
If Not rng Is Nothing Then
UnprotectMe
'process each cell
For Each c In rng.Cells
Me.Cells.Cells(c.Row, "I").Locked = _
(UCase(Trim(Me.Cells(c.Row, "H").Value)) <> "YES")
Next c
ProtectMe
End If
End Sub
Sub UnprotectMe()
Me.Unprotect Password:=PW
End Sub
Sub ProtectMe()
Me.protect userinterfaceonly:=True, Password:=PW
End Sub
I am trying to link a range of cells to a text box, the only problem is if I edit the text box, it will write in any cell. I want to limit that ability to a specific range ("C4 to C11"). Here is my code:
Dim PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 Then ActiveSheet.TextBox1.Text = Target
If Not PreviousCell Is Nothing Then
Debug.Print PreviousCell.Address
End If
Set PreviousCell = Target ' This needs to be the last line of code.
End Sub
Private Sub TextBox1_Change()
ActiveCell.Value = TextBox1
End Sub
Private Sub TextBox1_Change()
If ActiveCell.Column = 3 Then ActiveCell.Value = TextBox1
End Sub
The purpose of this code is to update the date in a cell as a certain cell's contents are changed.
Since this was originally coded inside a sub, I now need to expand this code to a range of multiple cells. Ie. At this moment, the code only takes cell D4 and updates cell L4, I want to be able to drag this function down so it can reach a multiple range of cells; take D5 and update L5 etc.
Here's my code as the sub:
Dim oldValue
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target.Worksheet.Range("D4").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
If oldValue <> Target.Worksheet.Range("D4").Value Then
Target.Worksheet.Range("L4").Value = Date
End If
End If
End Sub
The problem here, is that I don't know how to properly expand my code to match a further selection of cells. Here's my attempt:
Dim oldValue
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target.Worksheet.Range("D4", "D21").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("D4", "D21")) Is Nothing Then
If oldValue <> Target.Worksheet.Range("D4", "D21").Value Then
Target.Worksheet.Range("L4", "L21").Value = Date
End If
End If
End Sub
EDIT: The sub I have written only applies to one cell, I am trying to work out a way to have it spread out to a certain selection of cells. Ie. D4:D12 which updates the date in L4:L12 accordingly.
If anyone could help me, that would be greatly appreciated.
Try the following code:
Dim oldValue()
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Me.Range("D4:D12").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("D4:D12")) Is Nothing Then
Application.EnableEvents = False
Dim c As Range
For Each c In Intersect(Target, Me.Range("D4:D12"))
'Check value against what is stored in "oldValue" (row 4 is in position 1, row 5 in position 2, etc)
If oldValue(c.Row - 3, 1) <> c.Value Then
'Update value in column L (8 columns to the right of column D)
c.Offset(0, 8).Value = Date 'or possibly "= Now()" if you need the time of day that the cell was updated
End If
Next
Application.EnableEvents = True
End If
End Sub
Set up a hidden sheet to hold the old values.
Sub SetupMirrorValues()
With Worksheets.Add
.Name = "MirrorValues"
.visibilty = xlSheetVeryHidden
.Range("D4:D10,D12,D14:D20") = Worksheets("Sheet1").Range("D4:D10,D12,D14:D20")
End With
End Sub
In the Worksheet_Change event handler, you would check the Target cells that intersect with the range you want to monitor. If there are differences then you update the timestamp and the cell on the hidden sheet that corresponds to the changed cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim cell As Range, DRange As Range
Set DRange = Range("D4:D10,D12,D14:D20")
If Not Intersect(DRange, Target) Is Nothing Then
For Each cell In Intersect(DRange, Target)
If cell.Value <> Worksheets("MirrorValues").Range(cell.Address) Then
cell.EntireRow.Cells(1, "L").Value = Now
Worksheets("MirrorValues").Range(cell.Address) = cell.Value
End If
Next
End If
Application.EnableEvents = True
Application.ScreenUpdating = False
End Sub