My workbook has five sheets with text boxes.
Sheet1, Sheet2, ......, and Sheet5.
And the code below is on every sheet.
Private Sub TextBox1_Change()
If Len(TextBox1.Value) = 0 Then
ActiveSheet.AutoFilterMode = False
Else
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
End If
ActiveSheet.Range("A2:C" & Rows.Count).AutoFilter field:=1, Criteria1:="*" & TextBox1.Value & "*"
End If
End Sub
I would like to synchronize the TEXTBOXES on all sheets.
For example, if I type text in TEXTBOX1 of Sheet1, the same text will be entered in TEXTBOX1 of all other sheets.
And I also want to know how to clear TEXTBOX on every sheet at once.
1) put the following code in new Module of your project
Public dontDoThat As Boolean ' a public variable, visible throughout all your project you'll use to give way to synchronizing activity
Option Explicit
Sub Synchronize(txt As String, shtName As String)
dontDoThat = True ' set your public variable to True and prevent subsequent TextBox1_Change() events to run it again
Dim sht As Variant
For Each sht In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
If sht <> shtName Then Worksheets(sht).TextBox1.Text = txt
Next
dontDoThat = False ' set your public variable to False and allow subsequent TextBox1_Change() events to run it
End Sub
2) change your TextBox1_Change() event in all your sheets as follows
Private Sub TextBox1_Change()
If Not dontDoThat Then Synchronize Me.TextBox1.Text, Me.Name 'call Synchronize() only if your public variable allows it to
...
(rest of your previous code follows)
...
End Sub
To clear all textboxes just clear one of them
You can add module in your project and add this Sub there (adjusting names of sheets and TextBoxes, if needed):
Sub SetText(txt As String)
Worksheets("Sheet1").TextBox1.Text = txt
Worksheets("Sheet2").TextBox1.Text = txt
Worksheets("Sheet3").TextBox1.Text = txt
Worksheets("Sheet4").TextBox1.Text = txt
Worksheets("Sheet5").TextBox1.Text = txt
End Sub
Then, in Change event for every TextBox add this
Private Sub TextBox1_Change()
SetText Me.TextBox1.Text
End Sub
To clear all text you can set .TextBox1.Text = ""
Related
I am trying to test a cell for specific data. If it contains that data, I do not want my code to run (because that would leave my worksheet and workbook Unprotected). If the cell contains data that does not match the test specifics, then I want the code to run. My code is to unprotect the active workbook, then unprotect the active worksheet, then fill the value of cell N41 as the "sheet name", then protect the active worksheet, then protect the active workbook. I want to add the test to the top of the code to avoid security failures.
The data that I want to test the cell for is:
The cell does not contain more than 31 characters (including spaces between charaters)
The cell does not contain any of the following characters: \ / : ? * [ or ]
The cell is not blank (empty)
If any of the above data/characters are in the cell I want the code to not run and leave my password protection in place for both the protected worksheet and protected workbook.
If the cell contains less than 31 characters (including spaces), does not contain any of the unwanted characters, and has at least 1 character in it (not a blank cell) then I want the code to run. Any help would be greatly appreciated.
Private Sub CommandButton16_Click()
ThisWorkbook.Unprotect Password:="Password1"
ActiveSheet.Unprotect Password:="Password2"
ActiveSheet.Name = Range("N41").Value
ActiveSheet.Protect Password:="Password2"
ThisWorkbook.Protect Password:="Password1"
End Sub
I guess the real question is "How to check if some value is the correct name for a worksheet?" in order to minimize the period when the document is not protected, and to eliminate an error when renaming.
From the full list of naming conventions we can learn two additional rules. The name shouldn't be "History" and it shouldn't begin or end with an apostrophe '. Also, there shouldn't be other sheets with that name.
In my opinion, the easiest way to accomplish the main task is to wrap renaming with On Error statements.
Private Sub CommandButton_Click()
Const BookPass = "Password1"
Const SheetPass = "Password2"
Dim NewName as String
Dim ErrCode&, ErrDesc$, ErrMessage$
NewName = Range("N41").Value
With ThisWorkbook
.Unprotect BookPass
With ActiveSheet
.Unprotect SheetPass
On Error Resume Next
' ------ Main Part -------
.Name = NewName
' ------------------------
ErrCode = Err.Number
ErrDesc = Err.Description
On Error GoTo 0
.Protect SheetPass
End With
.Protect BookPass
End With
If ErrCode <> 0 Then
ErrMessage = "NewName=" & NewName & vbNewLine & _
"Error=" & ErrCode & vbNewLine & _
"Description: " & ErrDesc
MsgBox ErrMessage, vbCritical
End If
End Sub
p.s. I suppose, this code will be placed in the worksheet object module. In this case, it is better to replace ActiveSheet with Me for readability.
If you are prepared to weaken the Workbook protection, you can add use this code when protecting the Workbook.
Your code can then change the sheet name without unprotecting the WorkBook, but so can your users.
ActiveWorkbook.Protect Password:="Password1", Structure:=False
The WorkSheet can be protected to allow changes from your code but not by your users.
This way you protect the WorkSheet and never have to unprotect it.
ActiveSheet.Protect Password:="Password2", UserInterfaceOnly:=True
In your code, you can set a boolean value to true if a test passes and exit the sub with a custom message if a test fails. Then test the boolean value and if it is true, unprotect the Workbook, make the update and reprotect the Workbook.
Option Explicit
Private Sub ProtectAll()
ActiveWorkbook.Protect Password:="Password1"
' ActiveWorkbook.Protect Password:="Password1", Structure:=False
'Optional: Allow changes to sheet names and order, not ideal
'but allows you to not have to protect and unprotect the workbook
ActiveSheet.Protect Password:="Password2", UserInterfaceOnly:=True
'Allow changes to the active worksheet by VBA code, remains protected via the UI
End Sub
Private Sub UnprotectAll()
ActiveSheet.Unprotect Password:="Password2"
ThisWorkbook.Unprotect Password:="Password1"
End Sub
Private Sub ProtectWB()
ActiveWorkbook.Protect Password:="Password1"
End Sub
Private Sub UnprotectWB()
ThisWorkbook.Unprotect Password:="Password1"
End Sub
Private Sub Change()
Dim CellValue As String
Dim OKtoChange As Boolean
Dim ErrorMessage As String
CellValue = vbNullString
OKtoChange = False
CellValue = ActiveSheet.Range("N41").Value
If Len(CellValue) < 32 Then
OKtoChange = True
Else
ErrorMessage = "The WorkSheet name is more than 31 characters."
GoTo ErrorHandler
End If
'Other tests here to set the OKtoChange variable based on results
'If any test fails the code exits
If OKtoChange = True Then
Call UnprotectWB
ActiveSheet.Name = CellValue
Call ProtectWB
End If
Exit Sub
ErrorHandler:
MsgBox "Invalid name for the WorkSheet" & vbLf & ErrorMessage, vbCritical, "Invalid name"
End Sub
I have a to do list in excel. When a check box is checked a macro is ran that selects a specific cell and adds values to offsets of that cell. The problem is I have 600 check boxes and they all need their own code to reference the correct cells.
private sub checkbox1_click ()
Range ("I2").offset(0,3).value= "hello world"
Sub end
I want something like this:
Range ("location of checkbox I just checked").offset(0,3).value= "hello world"
This would be easier if you are using ActiveX control checkboxes instead of Form control.
With ActiveX control checkboxes, you can refer to the object as a part of Me, which points to the worksheet itself and use something like this:
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = True Then
Me.CheckBox1.TopLeftCell.Offset(0, 3).Value = "hello world"
End If
End Sub
If you can't use ActiveX controls, please let me know and I can adjust my answer. Note that you could also look at more information on how to make a checkbox refer to itself by looking at the answer to this question.
In the answer from PeterT, you can also see how to use a Class Module to avoid the problem of having one macro per checkbox. Here, I'm copying the relevant part of the answer:
[...] Create a class module that you can instantiate for any number of
CheckBoxes.
Code for Class module MyCheckBoxClass
Dim WithEvents cbControl As MSForms.CheckBox
Private controlName As String
Public Sub cbControl_Click()
Debug.Print controlName & " is now " & cbControl.Value
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
End Sub
Public Sub Attach(newCB As MSForms.CheckBox, newName As String)
Set cbControl = newCB
controlName = newName
End Sub
Private Sub Class_Initialize()
controlName = ""
End Sub
Code in a regular code module:
Public groupClickCount As Integer
Private cbCollection As Collection
Public Sub SetUpControlsOnce()
Dim thisCB As MyCheckBoxClass
Dim ctl As OLEObject
Dim cbControl As MSForms.CheckBox
If cbCollection Is Nothing Then
Set cbCollection = New Collection
End If
For Each ctl In ThisWorkbook.Sheets("Sheet1").OLEObjects
If TypeName(ctl.Object) = "CheckBox" Then
'--- this is an ActiveX CheckBox
Set thisCB = New MyCheckBoxClass
thisCB.Attach ctl.Object, ctl.name
cbCollection.Add thisCB
End If
Next ctl
End Sub
Of course, you would have to replace "Sheet1" with the appropriate name for your sheet and
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
With
If cbControl.Value = True Then
cbControl.TopLeftCell.Offset(0, 3).Value = "hello world"
End If
And finally, I would suggest to run the SetUpControlsOnce macro when you open the workbook by including it in the Open Event of the Workbook Object (Thisworkbook). ie.:
Private Sub Workbook_Open()
Call SetUpControlsOnce
End Sub
New here and I just started to teach myself coding. I have a workbook that has roughly 14 tabs/worksheets for employees to enter their hours worked per day. On a "Summary" tab and want to create a macro button for each employee to click on to view his/her tab. These employee tabs are hidden and all I want the action to do is unhide and then hide when the employee clicks their button.
Unfortunately, I receive an Ambiguous Error message and I created a module per employee. I assume I need to somehow "stack" code, but again am totally new to coding. Below is a sample of my code
Private Sub ShowHideWorksheets()
Sheets("EMPLOYEE 1").Visible = Not Sheets("EMPLOYEE 1").Visible
End Sub
you need to correctly put it behind a button. When you insert the button into the page, right click it and assign macro. The code would look like
Sub Button1_Click()
Sheets("EMPLOYEE 1").Visible = Not Sheets("EMPLOYEE 1").Visible
End Sub
Basically you wish to toggle visibility for a worksheet.
Assuming that you know which Sheet is going to be triggered, it is something like this:
Public Sub TriggerSheetVisibility(worksheetname as string)
Dim ws as WorkSheet
On Error Resume Next 'To avoid subscript out of range error if a worksheetname is passed that doesn't exit
Set ws = Worksheets(worksheetname)
On Error Goto 0
If Not ws Is Nothing Then 'Only when the worksheet exists, we can execute the rest of this sub:
If ws.Visible = True then
ws.Visible = False
Else
ws.Visible = True
End If
End If
End Sub
Also see https://msdn.microsoft.com/en-us/library/office/ff197786.aspx
This is also an acceptable approach? Prolly long winded though
Private Sub CommandButton1_Click()
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Sheets
If sheet.Name <> CommandButton1.Caption Then
sheet.Visible = False
End If
If sheet.Name = CommandButton1.Caption Then
sheet.Visible = True
End If
Next sheet
End Sub
However I like this better due to the fact you only need one button
Private Sub CommandButton1_Click()
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Sheets
If sheet.Name <> Environ("USERNAME") Then
sheet.Visible = False
End If
If sheet.Name = Environ("USERNAME") Then
sheet.Visible = True
End If
Next sheet
End Sub
If you change Private to Public it should work. I'm presuming you're just creating macros at this point to get base functionality to work. You can hide (as the code you've posted) and unhide like this:
' This first macro actually just makes the worksheet visible and then
' invisible each time you execute it - so I'm not sure if
' that's what you're after
Public Sub ShowHideWorksheets()
Sheets("EMPLOYEE 1").Visible = Not Sheets("EMPLOYEE 1").Visible
End Sub
' If it's invisible you can do this.
Public Sub ShowWorksheets()
Sheets("EMPLOYEE 1").Visible = True
End Sub
' Basically that should give you an idea of how to proceed.
I am using Excel 2003 with VBA, I am dynamically creating check box controls on a sheet and want to link the VBA controls to a class so that when a user clicks on a checkbox an event is fired so I can do something.
From what I've read it would seem that creating a user class is the solution, but having tried this I can't get it to work.
My user class looks like this:
Option Explicit
Public WithEvents cbBox As MSForms.checkbox
Private Sub cbBox_Change()
MsgBox "_CHANGE"
End Sub
Private Sub cbBox_Click()
MsgBox "_CLICK"
End Sub
My code to create the checkboxes:
For Each varExisting In objColumns
'Insert the field name
objColumnHeadings.Cells(lngRow, 1).Value = varExisting
'Insert a checkbox to allow selection of the column
Set objCell = objColumnHeadings.Cells(lngRow, 2)
Dim objCBclass As clsCheckbox
Set objCBclass = New clsCheckbox
Set objCBclass.cbBox = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1" _
, Left:=300 _
, Top:=(objCell.Top + 2) _
, Height:=10 _
, Width:=9.6).Object
objCBclass.cbBox.Name = "chkbx" & lngRow
objCBclass.cbBox.Caption = ""
objCBclass.cbBox.BackColor = &H808080
objCBclass.cbBox.BackStyle = 0
objCBclass.cbBox.ForeColor = &H808080
objCheckboxes.Add objCBclass
lngRow = lngRow + 1
Next
The checkboxes are visible in the sheet, but when I click on them, no message box is displayed so the link to the class doesn't seem to be working.
Why?
Edit...If after adding the checkboxes I go into the VB IDE and select one of the created checkboxes from the list of controls, then select Click from the Procedure drop down list, it will insert the code for a call back which if I add a message box to this, works when I click on the same checkbox...so how can I achieve this in code? I've tried recording a macro to do this, nothing was recorded.
Edit by S.Platten, jump to the bottom for how this helped me fix the problem...
Due to some weird reason, VBA doesn't hook up the events for Sheet's ActiveX control in the same execution cycle in which they were added. So, we need to come out of the cycle which added the controls and then invoke the event adding proc in next cycle. Application.OnTime helps here.
Its seems a bit of overkill but it works :)
Option Explicit
Dim collChk As Collection
Dim timerTime
Sub master()
'/ Add the CheckBoxes First
Call addControls
'<< Due to some weird reason, VBA doesn't hook up the events for Sheet's ActiveX control in the same
'execution cycle in which they were added. So, we need to come out of the cycle which added the controls
'and then invoke the event adding proc in next cycle. >>
'/ Start Timer. Timer will call the sub to add the events
Call StartTimer
End Sub
Sub addControls()
Dim ctrlChkBox As MSForms.CheckBox
Dim objCell As Range
Dim i As Long
'Intialize the collection to hold the classes
Set collChk = New Collection
'/ Here Controls are added. No Events, yet.
For i = 1 To 10
Set objCell = Sheet1.Cells(i, 1)
Set ctrlChkBox = Sheet1.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1" _
, Left:=1 _
, Top:=(objCell.Top + 2) _
, Height:=objCell.Height _
, Width:=100).Object
ctrlChkBox.Name = "chkbx" & objCell.Row
Next
End Sub
Sub addEvents()
Dim ctrlChkBox As MSForms.CheckBox
Dim objCBclass As clsCheckBox
Dim x As Object
'Intialize the collection to hold the classes
Set collChk = New Collection
'/ Here we assign the event handler
For Each x In Sheet1.OLEObjects
If x.OLEType = 2 Then
Set ctrlChkBox = x.Object
Set objCBclass = New clsCheckBox
Set objCBclass.cbBox = ctrlChkBox
collChk.Add objCBclass
Debug.Print x.Name
End If
Next
'/ Kill the timer
Call StopTimer
End Sub
Sub StartTimer()
timerTime = Now + TimeSerial(0, 0, 1)
Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _
Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _
Schedule:=False
End Sub
Class Module: clsCheckBox
Option Explicit
Public WithEvents cbBox As MSForms.CheckBox
Private Sub cbBox_Change()
MsgBox "_CHANGE"
End Sub
Private Sub cbBox_Click()
MsgBox "_CLICK"
End Sub
Edit continued...
The class (clsCheckbox):
Option Explicit
Public WithEvents cbBox As MSForms.checkbox
Private Sub cbBox_Click()
MsgBox "_CLICK"
End Sub
Module1
Public objCheckboxes As Collection
Public tmrTimer
Public Sub addEvents()
Dim objCheckbox As clsCheckbox
Dim objMSCheckbox As Object
Dim objControl As Object
Set objCheckboxes = New Collection
For Each objControl In Sheet1.OLEObjects
If objControl.OLEType = 2 _
And objControl.progID = "Forms.CheckBox.1" Then
Set objMSCheckbox = objControl.Object
Set objCheckbox = New clsCheckbox
Set objCheckbox.cbBox = objMSCheckbox
objCheckboxes.Add objCheckbox
End If
Next
Call stopTimer
End Sub
Public Sub startTimer()
tmrTimer = Now + TimeSerial(0, 0, 1)
Application.OnTime EarliestTime:=tmrTimer _
, Procedure:="addEvents" _
, Schedule:=True
End Sub
Public Sub stopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=tmrTimer _
, Procedure:="addEvents" _
, Schedule:=False
End Sub
The code in the sheet that adds the controls:
Dim objControl As MSForms.checkbox
For Each varExisting In objColumns
'Insert the field name
objColumnHeadings.Cells(lngRow, 1).Value = varExisting
'Insert a checkbox to allow selection of the column
Set objCell = objColumnHeadings.Cells(lngRow, 2)
Set objControl = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1" _
, Left:=300 _
, Top:=(objCell.Top + 2) _
, Height:=10 _
, Width:=9.6).Object
objControl.Name = "chkbx" & lngRow
objControl.Caption = ""
objControl.BackColor = &H808080
objControl.BackStyle = 0
objControl.ForeColor = &H808080
lngRow = lngRow + 1
Next
This isn't the entire project, but enough to demonstrate the workings.
You are currently using ActiveX controls. Yet, ActiveX controls are bound to specific naming conventions. For example: if you insert an ActiveX button onto a sheet and name it btnMyButton then the sub must be named btnMyButton_Click. The same applies to checkboxes. If you insert a new checkbox with the name CheckBox2 then the sub's name must be CheckBox2_Click. In short, there cannot be a sub with the name cbBox_Change associated to any ActiveX checkbox.
So, what you really need (with ActiveX controls) is a way to change the VBA code on a sheet. But thus far I have never come across any such code (VBA code to change VBA code on a sheet).
A much easier route would be if you'd be willing to use form controls instead.
The following sub will create a (form control) checkbox and assign the macro tmpSO to it. The sub tmpSO (unlike subs for ActiveX controls) does not need to reside on the sheet but can be in any module.
Sub Insert_CheckBox()
Dim chk As CheckBox
Set chk = ActiveSheet.CheckBoxes.Add(390.75, 216, 72, 72)
chk.OnAction = "tmpSO"
End Sub
Since a from control is calling the sub tmpSO you can use Application.Caller in that sub and thereby know which checkbox has been calling this sub.
Sub tmpSO()
Debug.Print Application.Caller
End Sub
This will return the name of the CheckBox. So, you can use this one sub for all of your checkboxes any dynamically handle them based on their names (possibly using a Case Select).
Here is another example for tmpSO:
Sub tmpSO()
With ThisWorkbook.Worksheets(1).CheckBoxes(Application.Caller)
MsgBox "The checkbox " & Application.Caller & Chr(10) & _
"is currently " & IIf(.Value = 1, "", "not") & " checked."
End With
End Sub
I am facing a problem in my excel workbook. I have 25+ sheets in my workbook
and I want to look to sheet1 time to time. Is their any way that I can freeze first
two sheets of my workbook?
Currently I am navigating through sheets by pressing ctrl+page up button.
FYI I am Using MS-Office 2007
If I have understood well: you want the users stay only on Sheet1 & 2:
In the Main event:
Private Sub Workbook_Open()
ActiveWindow.DisplayWorkbookTabs = False
End Sub
and in the Event:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveWindow.DisplayWorkbookTabs Then ActiveWindow.DisplayWorkbookTabs = False
If ((Sh.Name) <> "Sheet1") And ((Sh.Name) <> "Sheet2") Then Sheets("Sheet1").Select
End Sub
When open disable Tabs. If people show if you try to change the code return to Sheet1.
Ad Password to VBA macro ...If is only for quick change remove the code of Tabs...
This code (in the ThisWorkbook module) will keep Sheet1 just to the left of whatever sheet you're on.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.EnableEvents = False
If Sh.Name <> Sheet1.Name Then
Sheet1.Move Sh
Sh.Activate
End If
Application.EnableEvents = True
End Sub
It's a little weird pressing Ctrl+PgUp to navigate a bunch of sheets because it now takes two Ctrl+PgUps to move one sheet - one moves you onto Sheet1 (because it's always to the left) and the second moves you to the next sheet (which then moves Sheet1 to the left of it).
Maybe you could build in a timer so it only moves sheet1 if you've been on a sheet for a couple of seconds.
Update Using a timer
In a standard module:
Public gshToMove As Object
Public gdtTimeToMove As Date
Sub MoveSheet()
Application.EnableEvents = False
Sheet1.Move gshToMove
gshToMove.Activate
Set gshToMove = Nothing
gdtTimeToMove = 0
Application.EnableEvents = True
End Sub
In the ThisWorkbook module
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name <> Sheet1.Name Then
'if something's schedule, unschedule it
If gdtTimeToMove <> 0 Then
Application.OnTime gdtTimeToMove, "MoveSheet", , False
End If
'schedule the sheet move for three seconds from now
gdtTimeToMove = Now + TimeSerial(0, 0, 3)
Set gshToMove = Sh
Application.OnTime gdtTimeToMove, "MoveSheet", , True
End If
Application.EnableEvents = True
End Sub
You still get a little flash when the code actually runs.
In each sheet
Private Sub Worksheet_Activate ( )
Call Funciona
End Sub
In Module
Sub Funciona()
With ActiveSheet
If .Index > 1 Then
If .Previous.Name <> "Principal" Then
Sheets("Principal").Move Before:=ActiveSheet
End If
End If
End With
End Sub