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
Related
So I have a dynamically created worksheet (generated by clicking a command button on a separate sheet) and I am trying to get a Worksheet_Change event to fire only on a specific range in that worksheet. My code is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet
Set sh = ThisWorkbook.ActiveSheet
If Not Intersect(Target, Range("A1:K10")) Is Nothing Then
If sh.Name Like "*SP Temp*" Then
Dim i As Variant, countOfS As Integer
countOfS = 0
For Each i In sh.Range("A1:K10")
If i.Value = "S" Then
countOfS = countOfS + 1
End If
Next i
sh.Range("D12").Value = countOfS
sh.Range("D13").Value = SCount - countOfS
' NOTE: SCount is a global variable set in another Sub
End If
End If
End Sub
The intent is to keep a running count of the number of "S" characters entered into cells in the range A1:K10. I have tried adding in Debug.Print statements after the If Not Intersect... statement, but it doesn't seem to fire, despite the values in the target range being altered. What am I doing wrong?
A Workbook SheetChange: Count and Write
ThisWorkbook Module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Invalidate.
If Not Sh.Name Like "*SP Temp*" Then Exit Sub ' wrong worksheet
Dim rg As Range: Set rg = Sh.Range("A1:K10")
If Intersect(rg, Target) Is Nothing Then Exit Sub ' no intersection
' Count.
Dim CountOfS As Long: CountOfS = Application.CountIf(rg, "s")
' Write
' Disable events to not re-trigger the event while writing
' since the same worksheet is being written to.
Application.EnableEvents = False
Sh.Range("D12").Value = CountOfS
Sh.Range("D13").Value = SCount - CountOfS
Application.EnableEvents = True
End Sub
Every time I get the above run time error when I double-click to check the box or when I try to edit the data within a different cell by double-clicking. When I run the debug, this is what it shows me:
Private Sub CommandButton1_Click()
Dim chk As CheckBox
Dim lCol As Long
lCol = 10 'number of columns to the right for link
For Each chk In ActiveSheet.CheckBoxes
With chk
.LinkedCell = _
.TopLeftCell.Offset(0, lCol).Address
End With
Next chk
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("Check_box")) Is Nothing Then Exit Sub
Target.Font.Name = "marlett"
If Target.Value <> "a" Then
Target.Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents
Cancel = True
Exit Sub
End If
End Sub
It highlights this line:
If Intersect(Target, Range("Check_box")) Is Nothing Then Exit Sub
as if something is missing, but I cannot figure out what.
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
I'm looking for a way to write into another sheet in excel, every time someone either protects or unprotects the sheet in my Workbook. I want it to log whether it was protected or unprotected and the time beside it. Thanks!
Right now I have the following code for protecting or unprotecting the sheet with a more user friendly button:
If ActiveWorkbook.Sheets("Calendar").ProtectContents = True Then
ActiveSheet.Unprotect
MsgBox "Sheet unprotected"
Exit Sub
End If
ActiveSheet.Protect ("password")
MsgBox "Calendar has been protected"
Excel VBA does not have an event that can detect if a sheet is being protected/unprotected.
Don't shoot the messenger.
A google would have landed you here: https://www.ozgrid.com/forum/index.php?thread/43816-unprotect-worksheet-event/, the author even gives you a sample:
https://www.ozgrid.com/forum/core/index.php?attachment/1082834-52719-xls/
This is not 100% fool proof as the eventhandler can not tell when a user Cancels the protect/unprotect dialog.
This workbook
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StartEventListiner False
End Sub
Private Sub Workbook_Open()
StartEventListiner True
End Sub
Module
Option Explicit
Public g_clsEvnt As CProtectEvt
Public Sub StartEventListiner(Action As Boolean)
If Action Then
Set g_clsEvnt = New CProtectEvt
Else
Set g_clsEvnt = Nothing
End If
End Sub
Class
Option Explicit
Public WithEvents cbbProtect As CommandBarButton
Private Sub m_ProtectControls(State As Boolean)
Dim objX As OLEObject
On Error Resume Next
For Each objX In ActiveSheet.OLEObjects
objX.Object.Enabled = State
Next
End Sub
Private Sub cbbProtect_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
m_ProtectControls (InStr(1, Ctrl.Caption, "Un&protect", vbTextCompare) > 0)
End Sub
Private Sub Class_Initialize()
On Error Resume Next
' hook into Tools > Protection > Protect Sheet event
Set cbbProtect = Application.CommandBars.FindControl(msoControlButton, ID:=893)
End Sub
Toggle and Log Worksheet Protection
The code only logs the protection when using the button (which has toggleWorksheetProtection_Click assigned to it) or when running toggleWorksheetProtection_Click from VBE.
Copy the complete code into a standard module (e.g. Module11).
Adjust the values of the five constants.
ThisWorkbook refers to the workbook containing this code.
Additionally adjust the date format in writeLogRow.
The Code
Option Explicit
Sub toggleWorksheetProtection_Click()
' Constants
Const srcName As String = "Calendar"
Const tgtName As String = "Log"
Const tgtCol As Variant = 1
Const msgProtect As String = "Sheet protected."
Const msgUnProtect As String = "Sheet unprotected."
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Other Variables
Dim src As Worksheet: Set src = wb.Worksheets(srcName)
Dim tgt As Worksheet: Set tgt = wb.Worksheets(tgtName)
Dim msg As String
' Protection
If src.ProtectContents Then
src.Unprotect: msg = msgUnProtect
Else
src.Protect: msg = msgProtect
End If
' Log
Dim cel As Range
Set cel = getEmptyCell(tgt, tgtCol)
writeLogRow cel, msg
End Sub
Function getEmptyCell(Sheet As Worksheet, ByVal writeColumn As Variant)
Dim cel As Range
Set cel = Sheet.Columns(writeColumn).Find("*", , xlValues, , , xlPrevious)
If Not cel Is Nothing Then
Set cel = cel.Offset(1)
Else
Set cel = Sheet.Cells(1, writeColumn)
End If
Set getEmptyCell = cel
End Function
Sub writeLogRow(logRange As Range, ByVal logMessage As String)
Dim logDate As Date: logDate = Now
logRange.Value = logDate
logRange.NumberFormat = "mm/dd/yyyy hh:mm:ss (ddd)"
logRange.Offset(, 1).Value = logMessage
End Sub
I'm trying to finish this off so that I can click on cells ws2(D11) and ws3(C12) and show a box containing the ClientNumber. I just can't get my head around how that works, as I've tried to adapt some solutions to my code, but have been unsuccessful, and don't know quite why.
Public ClientNumber As String
Sub Booker()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws = Sheets("ClientEnd")
Set ws2 = Sheets("Booking End")
Set ws3 = Sheets("Training End")
Dim ClientName As String
ClientName = InputBox("Please enter your name")
ClientNumber = InputBox("Please enter a contact number")
ws2.Range("D11") = ClientName
ws3.Range("C12") = ClientName
ws2.Range("O11:R11").Style = "Good"
ws3.Range("H12:K12").Style = "Good"
ws3.Range("I12").Style = "Normal"
Call NumberBox
End Sub
Sub NumberBox()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws = Sheets("ClientEnd")
Set ws2 = Sheets("Booking End")
Set ws3 = Sheets("Training End")
If Target.Address = ws2.Range("$D$11") Then MsgBox ClientNumber
If Target.Address = ws3.Range("$C$12") Then MsgBox ClientNumber
End Sub
I was hoping to have the ClientNumber pop up in a message when I clicked on the given cells in each sheet, which do update to the ClientName successfully, but nothing happens. No errors, nothing.
You can use the event Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean).
In ws3 put
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C12")) Is Nothing Then 'range than u want to capture
Call NumberBox 'your code
End If
End Sub
Do the same for ws2
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("D11")) Is Nothing Then 'range than u want to capture
Call NumberBox 'your code
End If
End Sub
You have to double click on the cell to run the event
You could try adding the SelectionChange event to the worksheets. On Worksheet 2 and 3 Add the code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "&D&11" Then 'Change the "&D&11" to "&C&12" for worksheet 3
Call NumberBox ' You could also add Target as a paramater
End If
End Sub