I would like to click on E15 and put the value from E16. How can I do that ?
My code is :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Not Intersect(Target, Range("C6")) Is Nothing Then
Call CLICK_BTN_INFOS_CONTRAT
End If
Dim TabRes() As String
If Target.Value = [E15].Value Then
ReDim TabRes(0 To UBound(Split([Target], ",")))
For i = LBound(TabRes) To UBound(TabRes)
TabRes(i) = Split(Split([Target], ",")(i), "-")(1)
MsgBox TabRes(0)
GET_GROUPE_GESTION_CIBLE TabRes(0)
Next i
End If
End Sub
You are using the wrong event handler. In terms of what you ask, see below code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, ActiveSheet.Range("E15")) Is Nothing Then
Target.Value = Target.Offset(0,1).Value
'or
'Target.Value = ActiveSheet.Range("E16").Value
'or
'ActiveSheet.Range("E15").Value = ActiveSheet.Range("E16").Value
End If
End Sub
EDIT
After seeing your comments I am editing. If you are selecting from a dropdown then your event handler is correct, i.e. Worksheet_Change(). The below should meet your requirements..
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, ActiveSheet.Range("E15")) Is Nothing Then
Dim inputString As String
Dim stringArray As Variant
Dim argString as String
'store E15 to a string variable
inputString = Target.Value
'create array from string
stringArray = Split(inputString, " ")
'store E16 to variable to pass to function call
argString = Target.Offset(1, 0).Value
'call function
GET_GROUPE_GESTION_CIBLE(argString)
End If
End Sub
Related
With the use of call statement, I am calling a sub RETURNSEARCHMATCHES that includes UDF FINDCOLLETTEROFNAMEDRANGE(string).
The code where I call the function is below:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Selection.Count = 1 Then
If Not Intersect(Target, Range("SearchField")) Is Nothing Then
Call OSS_macros.RETURNSEARCHMATCHES
End If
End If
Application.EnableEvents = True
End Sub
I was debugging the code inside RETURNSEARCHMATCHES and I found out that the UDF function FINDCOLLETTEROFNAMEDRANGE(string) is not called by the sub (the code is below):
Public Function FINDCOLLETTEROFNAMEDRANGE(range_name As String) As String
Dim cell_range As Range
Set cell_range = Range(range_name)
If cell_range.Address(0, 0) <> "" Then
FINDCOLLETTEROFNAMEDRANGE = Left(cell_range.Address(0, 0), 1)
Else
FINDCOLLETTEROFNAMEDRANGE = "NONE"
End If
End Function
Sub RETURNSEARCHMATCHES()
Dim cw As Worksheet
Dim is_matchLeft_name As String
Dim is_matchLeft_col As String
Dim last_row As String
Set cw = Sheets("4c.Travel Costs (Search)")
last_row = CStr(cw.Cells(cw.Rows.Count, 2).End(xlUp).Row)
Debug.Print "OK"
is_matchLeft_name = "Is_Match_from_left"
is_matchLeft_col = FINDCOLLETTEROFNAMEDRANGE(is_matchLeft_name)
Debug.Print is_matchLeft_col
End Sub
Do you know why it is like this?
Am I supposed to pass this UDF function somewhere in the call statement?
I am trying to pass row number to UserForm, so it could display data in user friendly way for end user, but having trouble catching this variable on Initialize moment.
Code in the Worksheet module, it should open UserForm and pass row number as variable:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange As ListObject
Dim xRow As Long
xRow = Target.Row
Set DataRange = Sheets("Forecast").ListObjects("ForecastTable")
If Application.Intersect(Target, DataRange.DataBodyRange) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
MsgBox xRow
With FullInfo
.MyProp = xRow
.Show
End With
End If
End Sub
This is the code in UserForm:
Property Let MyProp(xRow As Long)
publicRow = xRow
End Property
Private Sub UserForm_Initialize()
Dim publicRow As Long
MsgBox publicRow
End Sub
From MsgBox I used for testing I determined that code in the sheet module returns correct row number, but then UserForm is initialized it shows 0 as no data is received. Interestingly enough, I put a button in the user form for testing with following code:
Private Sub Save_Click()
MsgBox publicRow
End Sub
After pressing it - it shows correct row number, so it means it passed but only after Initialize event. How should I pass variable to UserForm so it would be available at Initialize event?
I have a solution for you. :)
...so this is your code corrected ...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange As ListObject
Dim xRow As Integer
Dim FullInfo As Object
xRow = Target.Row
Set DataRange = Sheets("Forecast").ListObjects("Tabela1")
If Application.Intersect(Target, DataRange.DataBodyRange) Is Nothing Or
Target.Cells.Count > 1 Then
Exit Sub
Else
Set FullInfo = New UserForm1
With FullInfo
.Label1.Caption = xRow
.Show
End With
End If
End Sub
... if you want to go further, I have another way to pass a public variable to userForm
You code in sheet
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange2 As ListObject
Dim xRow As Integer
xRow = Target.Row
Set DataRange2 = Sheets("Arkusz1").ListObjects("Tabela2")
If Application.Intersect(Target, DataRange2.DataBodyRange) Is Nothing Or
Target.Cells.Count > 1 Then
Exit Sub
Else
Call UserFormStart(xRow)
End If
End Sub
Put code to new module (in the worksheet do not work)
'Public rowSelection As Integer 'declare public variable
Public Sub UserFormStart(ByVal rowRef As Integer)
rowSelection = rowRef
UserForm1.Show
End Sub
In your userForm
Private Sub CommandButton1_Click()
MsgBox rowSelection & " it's work"
End Sub
Public Sub UserForm_Initialize()
MsgBox rowSelection
End Sub
It works for me :)
You can check one topic
Excel - VBA : pass variable from Sub to Userform
I am new to VB script and only have the least idea about how it works.
With the below code the idea is that the users will be able to edit/ add details to an Excel worksheet but would not able to delete any data without a password. One of the columns is for adding comments and it is not mandatory that each item should always have a comment. The below code will blindly protect the whole sheet but I need to add an exclusion to column N6:N1000. Would someone here please help me to add this exclusion.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sPassCheck As String
Dim rng As Range
Dim sTemp As String
Dim sPassword As String
sPassword = "12345"
sTemp = "You must enter the password to delete data"
'Use to set a single cell if more than one cell is
'in the target range
If Target.Count > 1 Then
Set rng = Target.Cells(1, 1)
Else
Set rng = Target
End If
If rng.Value = "" Then
sPassCheck = InputBox(sTemp, "Delete check!")
Application.EnableEvents = False
If sPassCheck <> sPassword Then Application.Undo
End If
Application.EnableEvents = True
End Sub
This modification should do it
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sPassCheck As String
Dim rng As Range
Dim sTemp As String
Dim sPassword As String
sPassword = "12345"
sTemp = "You must enter the password to delete data"
' Check if target is within Range N6:N1000
If Intersect(Target, Range("N6:N1000")) Is Nothing Then
If Target.Count > 1 Then
Set rng = Target.Cells(1, 1)
Else
Set rng = Target
End If
If rng.Value = "" Then
sPassCheck = InputBox(sTemp, "Delete check!")
Application.EnableEvents = False
If sPassCheck <> sPassword Then Application.Undo
End If
End If
Application.EnableEvents = True
End Sub
I am trying to combine these two codes, the first one is to change the name of my worksheet when I change the value of the cell m3, and the second code is to block the cells after modifying the cells. I am new in VBA so I don't know how to combine them.
CODE 1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$3" Then RenameSheet
End Sub
CODE 2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("F6"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="1234"
xRg.MergeArea.Locked = True
Target.Worksheet.Protect Password:="1234"
End Sub
Also sub renamesheet code is:
Sub RenameSheet()
Dim rs As Worksheet
For Each rs In Sheets
If rs.Name <> "MENU" And rs.Name <> "CAJA_CONTABILIDAD" Then
rs.Name = "Vale " & rs.Range("M3")
End If
Next rs
If Target.Address = "$M$3" Then RenameSheet
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$3" Then
RenameSheet
Exit Sub
End If
Dim xRg As Range
Set xRg = Intersect(Range("F6"), Target)
On Error Resume Next
If Not xRg Is Nothing Then
Target.Worksheet.Unprotect Password:="1234"
xRg.MergeArea.Locked = True
Target.Worksheet.Protect Password:="1234"
End If
End Sub
i'm clueless, i'm trying to build a code that input a prefix to a cell value after i change that cell, i mean i'll select a cell and input "342" for example, after i update that value i want the private sub to change that cell value to "GO-342", i've tried this, but it dosen't work.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$3" Then
If Left(Range("D3"), 2) = "GO" Then Exit Sub
Range("D3") = "GO-" & Range("D3")
End If
End Sub
the entire code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Cabeçalho
Dim rng As Range
Set rng = Range("D3,D5,I3,O3,O5,O7,X3,X5")
If Intersect(Target, rng) Is Nothing Then Exit Sub
For Each R In rng
If R.Value = "" Then
Exit Sub
End If
Next R
Create
'Km
Dim rng1 As Range
Set rng1 = Range("X3,X5")
If Intersect(Target, rng1) Is Nothing Then Exit Sub
For Each R In rng1
If R.Value = "" Then
Exit Sub
End If
Next R
Km
'GO
If Target.Address = "$D$3" Then
If Left(Range("D3"), 2) = "GO" Then Exit Sub
Application.EnableEvents = False
Range("D3") = "GO-" & Range("D3")
Application.EnableEvents = True
End If
End Sub
"Cabeçalho" and "Km" works but "GO" dosen't
Here is a tiny mod to your code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$3" Then
If Left(Range("D3"), 2) = "GO" Then Exit Sub
Application.EnableEvents = False
Range("D3") = "GO-" & Range("D3")
Application.EnableEvents = True
End If
End Sub
The code must be placed in the worksheet code area.Macros must be enabled.