I am new at coding and am looking for some help. I have a code here that is giving me the "case outside select case" error, but my case is inside "select case" and "end select" so I'm not sure what I'm doing wrong.
Sub codematch()
Dim wbk As Workbook
Select Case response = MsgBox("Is the cursor in the first cell of the column?", vbYesNo, "Code Finder")
Case condition1
If response = 6 Then
Set wbk = Workbooks.Open("C:\test.xlsm")
Call wbk
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'[test.xlsm]Sheet1'!C1:C2,2,0)"
Do Until ActiveCell = ""
Call wbk.Close(False)
Case condition2
If response = 7 Then
response = MsgBox("Position the Cursor in the correct location and try again", vbOKOnly)
End If
End Select
End Sub
Most of your code is pointless frankly. Who cares where the user has the cursor.
Sub codematch()
dim target as range
set target = range("B1") 'or whever you want to start
Dim wbk As Workbook
Set wbk = Workbooks.Open("C:\test.xlsm")
Target.FormulaR1C1 = "=VLOOKUP(RC[-1],'[test.xlsm]Sheet1'!C1:C2,2,0)"
do
set target = target.offset(1,0)
target.offset(-1,0).copy target
loop until target.offset(0,-1)=""
target.clear
target.parent.columns(target.column).cells.formula =
_target.parent.columns(target.column).cells.value 'convert to values
wbk.close false
end sub
Is what I think you were trying to do
Related
I'm trying to write a code to trace every change made by the user on any worksheet. The user will input data and from time to time will erase said data and/or correct the original value they inserted. If the change is either deletion or modification, an Userform will pop up and the user will include a reason for that change. Right now I'm able to display the form everytime the user makes one of the changes mentioned before, but I'm not able to retrieve the reason, could you guys help me?
This is what I have for the UserForm
Private Sub CommandButton1_Click()
Dim msgvalue As VbMsgBoxResult
Dim value As String
msgvalue = MsgBox("Do you wish to save the change?", vbYesNo + vbInformation, "Confirm")
If msgvalue = vbNo Then GoTo Command
If msgvalue = vbYes Then
value = UserForm1.txtCmmt.Value
If value = "" Then GoTo Command
End
End If
Command:
MsgBox ("A reason must be provided")
With UserForm1
.txtCmmt.Value = ""
End With
End Sub
So if a user tries to delete a value, the code is the following:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sLastAction As String
Dim Cell As Range
sLastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
For Each Cell In Target
If sLastAction = "Clear" Or sLastAction = "Delete" Or Left(sLastAction, 9) = "Typing ''" Then
UserForm1.Show 'this is where I'm stuck, I'm not sure how to retrieve the value from the form
End If
'the code continues to retrieve other info from the changes made, including the "reason"
Thanks for the help!
Try the next way, please:
Let us say that your text box where the comment will be written is named "txtComment".
Put this code in its Exit event:
Private Sub txtComment_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.txtComment.text <> "" Then
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & rows.count).End(xlUp).Offset(0, 5).Value = Me.txtComment.text
Application.EnableEvents = True
Unload Me
End If
End If
End Sub
Let the existing Worksheet_Change event as it is, only launching the form and maybe making a Public boolean variable (from a standard module) True (something boolStop) which will not allow changing anything in any worksheet until it is not False.
Then fill the text you need in the text box ("txtComment", or however you named it) and press Enter. If my above suggestion looks interesting for you, the last line of the text box event will be boolStop = False.
If you understand how to implement the above simple solution, you maybe will forget about a user form and use a simple InputBox, as in the next example:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "E1" Then Exit Sub
Dim sLastAction As String, comValue As String
Dim Cell As Range
sLastAction = Application.CommandBars("Standard").Controls("&Undo").list(1)
For Each Cell In Target
If sLastAction = "Clear" Or sLastAction = "Delete" Or left(sLastAction, 9) = "Typing ''" Then
WritePlease:
comValue = InputBox("Please write the reason for cell """ & Cell.Address & """ (" & sLastAction & ").", "Reason, please")
If comValue = "" Then GoTo WritePlease
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
'Stop
Sheets("LogDetails").Range("A" & rows.count).End(xlUp).Offset(0, 5).Value = comValue
Application.EnableEvents = True
End If
End If
Next
End Sub
My first post here, but have been successfully sourcing solutions and ideas from this website for a while now. So thanks for the collection of solutions and ideas.
Basically, I have a spread sheet application requiring the first column, Column A, to be filled with "Active X" buttons in every cell, looping through for a given quantity. I have posted one such working solution below which makes use of "form type buttons" and a Modules. This exemplifies what I consider my most favored example with working buttons. Once operational the column of buttons will correspond to relative data on the same row, and when clicked will open corresponding folders, and userforms in later developments.
The second post uses the Range function, but obviously doesn't incorporate any buttons to interactive with. However, a mouse click over this Range will obviously activate any code from within the Worksheet_Selection Change procedure...Sorry just stating the obvious!
What I have been trying to achieve is a version of code employing "activeX" Command Buttons, but after having studied some great tutorials and poured over a range of programing concepts, I still fail miserably to employ OLEObjects.
How to add a button programmatically in VBA next to some sheet cell data?
Sheet 1 Procedure:
Sub ColumnA_Buttons()
Dim buttons As Button
Dim rng As Range
Dim LineQty As Variant
Application.ScreenUpdating = False
ActiveSheet.buttons.Delete
LineQty = 5
For i = 1 To LineQty
Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
Set buttons = ActiveSheet.buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
With buttons
.OnAction = "Buttons"
.Caption = "Line " & i
.Name = "Line " & i
End With
Next i
Application.ScreenUpdating = True
End Sub
Public Click_Button As Variant ' Make Variable Public for Userform1
'
Form Button Module:
Sub Line_Buttons()
Click_Button = Application.Caller
MsgBox Click_Button & " was Clicked"
UserForm1.Show 'Launch custom userform
End Sub
And the next option to be considered is a range detection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' e.g., range(A1:E1) is clicked
If Not Application.Intersect(Target, Range("B2:B12")) Is Nothing Then
MsgBox "You clicked " & Target.Address
End If
End Sub
Ok. I'm posting some code that I've been working on based on this post here: Multiple active X checkboxes... . It seems I've now come to the same stand still they did as descibed in their last post :
"Yes it is individual checkboxes. You can emulate control arrays in
VBA so that each checkbox uses the same click event code, but that is
probably overkill IMO. "
And if I read Jason's post above, this is what he's questioning regarding the event code.
Any assistance welcomed in completing this code, as I have Not yet seen a working example which interlocks it to a single event, as per the form button module above.
Sub Macro1()
Dim objCmdBtn As Object
Dim i As Integer
Dim Rnge As Range
Set ColumnRange = Range("A:A") ' Set width & height of column A
ColumnRange.ColumnWidth = 5: ColumnRange.RowHeight = 15.75
'Delete previous objCmdBtn
For Each objCmdBtn In ActiveSheet.OLEObjects
If TypeName(objCmdBtn.Object) = "CommandButton" Then objCmdBtn.Delete
Next objCmdBtn 'TypeName Function returns the data-type about a variable - TypeName(varname is objCmdBtn)
With ActiveSheet
For i = 1 To 25
Set Rnge = ActiveSheet.Range(Cells(i + 1, 1), Cells(i + 1, 1))
Set objCmdBtn = Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=Rnge.Left, _
Top:=Rnge.Top, _
Width:=Rnge.Width, _
Height:=Rnge.Height)
With objCmdBtn
'set a String value as object's name
'.Name = "CommandButton1"
With .Object
.Caption = i
With .Font
.Name = "Arial"
.Bold = True
.Size = 7
.Italic = False
.Underline = False
End With
End With
End With
Next
End With
End Sub
Here is an example of ActiveX buttons being created and coded to run. It may take some small tweaks, but will get the job done.
Sub CreateButton()
Dim Obj As Object
Dim Code As String
Dim cellLeft As Single
Dim cellTop As Single
Dim cellwidth As Single
Dim cellheight As Single
Dim LineQty as Integer
Sheets("Sheet1").Select
LineQty = 5
For i = 1 To LineQty
Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
cellLeft = rng.Left
cellTop = rng.Top
cellwidth = rng.Width
cellheight = rng.Height
'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=cellLeft, Top:=cellTop, Width:=cellWidth, Height:=cellHeight)
Obj.Name = "TestButton"
'button text
ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"
'macro text to be added possibly by array?
Code = "Private Sub TestButton_Click()" & vbCrLf
Code = Code & "Call Tester" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines
.CountOfLines + 1, Code
End With
Next i
End Sub
Sub Tester()
MsgBox "You have clicked on the test button"
End Sub
Note In order for this to not error on me, I had to go to the trust center and to trust center settings and macro settings and check the box "Trust Access to the VBA Project Object Model"
I currently have a workbook that contains several 'veryhidden' sheets, which only will become visible when the correct password has been entered. However, in the case that the correct password is entered, how do I write a code which activates that sheet that just has become visible, i.e. Excel needs to ignore all the 'veryhidden' ones.
I have tried the code:
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
End Sub
However, this does not work.
Declare Global variables in separate module
say ,
Global Const g_sPassword As String = "password"
on the next module where you need to code ,do it as below
'mention only sheets that should be visible ,other sheets will be automatically hided
Sub OpenSheet(sSheetName As String)
Dim shtSheetToOpen As Worksheet, shtLoopSheet As Worksheet
Set shtSheetToOpen = ThisWorkbook.Sheets(sSheetName)
Application.ScreenUpdating = False
shtSheetToOpen.Visible = xlSheetVisible
For Each shtLoopSheet In ThisWorkbook.Sheets
If shtLoopSheet.Name <> shtSheetToOpen.Name And shtLoopSheet.Name <> "Sheets to be visible" Then
shtLoopSheet.Visible = xlVeryHidden
End If
Next shtLoopSheet
shtSheetToOpen.Activate
Set shtSheetToOpen = Nothing
Set shtLoopSheet = Nothing
End Sub
' then include the below code
Sub OpenSample()
Dim sUserInput As String
sUserInput = InputBox("Please enter password", "Password Prompt", "")
If sUserInput = g_sPassword Then
MsgBox "Access Granted", vbInformation, "Access"
Call OpenSheet("Sheetsname")
sheetname.Activate
Else
MsgBox "Incorrect Password.Please try again", vbCritical, "Error"
End If
End Sub
how do I write a code which activates that sheet that just has become visible
You can store the sheet that you are unhiding in an object and then activate
For example
Private ws As Worksheet
Sub UnhideCode()
'<~~ Just an example since I do not know how you are unhiding
If pass = "OK" Then
Set ws = Sheet1 '<~~ Change this to the relevant sheet
ws.Visible = xlSheetVisible
End If
End Sub
Sub MoveNext()
If Not ws is Nothing then ws.Activate
End Sub
We are currently trying to get the encryption macro to work on multiple cells throughout the workbook, I have a lot going on with some of these cells so I am open to anything to make this flow better. Currently, the macro is under our finalize form button. This is the coding on sheet 1, the function code is under "this workbook"
When we try running this under other worksheet_selectionchange(ByVal target As Range) code, it doesn't allow the text box (got_focus) code to run on the cell.
I've tried changing the location of the code whether its in its own sub or being called to with a button and I'm unable to get this to correct itself. the cell that is in range is merged and would be ("B23:D23"), but making that change didn't change my debug error.
Private Sub FINALIZEBTN_Click()
Dim response As VbMsgBoxResult
response = MsgBox("Have you completed the form in full?", vbYesNo)
If response = vbYes Then
MsgBox "Do not forget to save and submit this form"
ElseIf response = vbNo Then
MsgBox "Please review and complete the form in full"
Exit Sub
End If
Dim searchRange As Excel.Range
Dim cell As Variant
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[^ :#a-zA-Z0-9&\-]+"
.Global = True
.MultiLine = True
End With
Set searchRange = ActiveSheet.Range("B18:E52") '// Change as required
For Each cell In searchRange.Cells
If RegEx.Test(cell) Then cell.value = RegEx.Replace(cell.value, "")
cell.value = UCase(cell.value)
Next cell
Set searchRange = Nothing
Set RegEx = Nothing
'ENCRYPTION MACRO
Dim KeyCells As Range
Set KeyCells = Range("B23")
Dim publicKey As String
publicKey = "<RSAKeyValue><Modulus>r2+QhdQrh+jlSz/F2f9TyfVbar79NUHqiQby7paaUB5pejiYg/aI8on642s0FYNiiASSqK81+ORA9BXS0AHMnnkyplWZ7B2/KnrmFb3Ujoemzb794MpmUxtztrAocmIepJwsuShBQD2eUvCzNKI8aLcgH9mDGuG/HvagHCyzbyfV+yPtMGIHY2W1qboFGGvisAgVGjUgUAzpsqbuHiP1muohr5yKRmeyTwZmjEeWY/OuoX5zyDvjd0jsCw8GiNzkPqb6qCZR8KXSZNcyZnf4NbjR/dOD5qeEwFZWY32LmGFQW4GVOUfaIStvRwXq1G7k5oPXb6ccAhDtlrieM9l65p0X9alGYfTvLel4SBRRMqc8icadJq4KXTh1qRwp7w6uJUnd90GqfMXo1Qqyjwuqre0BBro/e3/BH8BorWynby3JAD5GNnBrB/RX9y/DFobNHXV9vtNhMTBMhCfSMhJQNlnH8nT3jcdvydbWEpNuJt3EKoCiOQlRXyv+bBL2sVTSzdCV4cWj7CfX5ZVCaliBu4nybqWOszZyQJqCHZCgnPj2Pww7wHkFUHqngiKdK6T45IkcdohLS8AU+zCUD9K6R6qTBG1S8JKkmEfuBhNx+uWMU0fwEL6ThhUmUAqZAm7MBKxnBkR+yoT5zsHoi3aYYi9sF7Opw+acqtY9zqi/OA0=</Modulus><Exponent>AQAB</Exponent></RSAKeyValue>" 'put entire xml string here
If Not Application.Intersect(KeyCells, Range(target.Address)) Is Nothing Then
Application.EnableEvents = False
If VarType(Range(target.Address).value) <> 8204 Then
If Len(Range(target.Address).value) < 256 Then 'making sure that encry sting isnt previously encrypted
Range(target.Address).value = ThisWorkbook.Encrypt(publicKey, CStr(Range(target.Address).value))
Range(target.Address).HorizontalAlignment = -4108 'XLALIGNCENTER
End If
Else
Range(target.Address).HorizontalAlignment = -4131 'XLALIGNLEFT
End If
Application.EnableEvents = True
End If
End Sub
The line
If Not Application.Intersect(KeyCells, Range(target.Address)) Is Nothing Then causes the run-time error 424 object required pop up.
I have an input box asking user to enter a date. How do I let the program know to stop if the user click cancel or close the input dialog instead of press okay.
Something like
if str=vbCancel then exit sub
Currently, user can hit OK or Cancel but the program still runs
str = InputBox(Prompt:="Enter Date MM/DD/YYY", _
Title:="Date Confirmation", Default:=Date)
If the user clicks Cancel, a zero-length string is returned. You can't differentiate this from entering an empty string. You can however make your own custom InputBox class...
EDIT to properly differentiate between empty string and cancel, according to this answer.
Your example
Private Sub test()
Dim result As String
result = InputBox("Enter Date MM/DD/YYY", "Date Confirmation", Now)
If StrPtr(result) = 0 Then
MsgBox ("User canceled!")
ElseIf result = vbNullString Then
MsgBox ("User didn't enter anything!")
Else
MsgBox ("User entered " & result)
End If
End Sub
Would tell the user they canceled when they delete the default string, or they click cancel.
See http://msdn.microsoft.com/en-us/library/6z0ak68w(v=vs.90).aspx
Following example uses InputBox method to validate user entry to unhide sheets:
Important thing here is to use wrap InputBox variable inside StrPtr so it could be compared to '0' when user chose to click 'x' icon on the InputBox.
Sub unhidesheet()
Dim ws As Worksheet
Dim pw As String
pw = InputBox("Enter Password to Unhide Sheets:", "Unhide Data Sheets")
If StrPtr(pw) = 0 Then
Exit Sub
ElseIf pw = NullString Then
Exit Sub
ElseIf pw = 123456 Then
For Each ws In ThisWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next
End If
End Sub
The solution above does not work in all InputBox-Cancel cases. Most notably, it does not work if you have to InputBox a Range.
For example, try the following InputBox for defining a custom range ('sRange', type:=8, requires Set + Application.InputBox) and you will get an error upon pressing Cancel:
Sub Cancel_Handler_WRONG()
Set sRange = Application.InputBox("Input custom range", _
"Cancel-press test", Selection.Address, Type:=8)
If StrPtr(sRange) = 0 Then 'I also tried with sRange.address and vbNullString
MsgBox ("Cancel pressed!")
Exit Sub
End If
MsgBox ("Your custom range is " & sRange.Address)
End Sub
The only thing that works, in this case, is an "On Error GoTo ErrorHandler" statement before the InputBox + ErrorHandler at the end:
Sub Cancel_Handler_OK()
On Error GoTo ErrorHandler
Set sRange = Application.InputBox("Input custom range", _
"Cancel-press test", Selection.Address, Type:=8)
MsgBox ("Your custom range is " & sRange.Address)
Exit Sub
ErrorHandler:
MsgBox ("Cancel pressed")
End Sub
So, the question is how to detect either an error or StrPtr()=0 with an If statement?
If your input box is an array, it does not work. I have solved it by adding a check for if it is an array first.
Dim MyArrayCheck As String
Dim MyPlateMapArray as variant
MyPlateMapArray = Application.InputBox("Select ....", Type:=8)
MyArrayCheck = IsArray(MyPlateMapArray)
If MyArrayCheck = "False" Then
Exit Sub
End If
I have solved it with a False like below
MyLLOQ = Application.InputBox("Type the LLOQ number...", Title:="LLOQ to be inserted in colored cells.", Type:=1)
If MyLLOQ = False Then Exit Sub
If user click cancel the sub will exit.
Another suggestion.
Create a message box when inputbox return null value. Example:
Dim PrC as string = MsgBox( _
"No data provided, do you want to cancel?", vbYesNo+vbQuestion, "Cancel?")
Sub TestInputBox()
Dim text As String
text = InputBox("Type some text")
If text = "" Then
MsgBox "button cancel pressed or nothing typed"
Else
MsgBox text
End If
End Sub
Inputbox send a boolean False value when Cancel is pressed.
contenidoy = Application.InputBox("Cantidad = ", titulox, contenidox, , , , , Type:=1)
'ESC or CANCEL
If contenidoy = False Then
MsgBox "Cancelado"
Else
MsgBox "Edición aceptada"
'End If