Add pop up window to macro - excel

I recently found a macro to delete hidden names in a given workbook.
What I'd like to add to it is a pop up window that would first display how many names there are, and a yes no button for running it. Just to give the user an idea of how long the function will take to run if they choose to run it.
This is the code as is:
Dim RangeName As Name
On Error Resume Next
For Each RangeName In Names
ActiveWorkbook.Names(RangeName.Name).Delete
Next
On Error GoTo 0
End Sub

Try this:
Sub test()
Dim RangeName As Name
Dim answer As Integer
Dim str As String
On Error Resume Next
str = "Do you want to delete " & ActiveWorkbook.Names.Count & " names?"
answer = MsgBox(str, vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
If answer Then
For Each RangeName In Names
ActiveWorkbook.Names(RangeName.Name).Delete
Next
Else
Exit Sub
End If
On Error GoTo 0
End Sub

Related

Workbooks.Open failing in specific circumstances

So I have a a function in my project that's is built to look for a workbook, check if it's open, then open that workbook if it's closed.
Public Function CheckOpen(wbName As String)
Dim wb As Workbook
Dim Ret_type As Integer
Dim strMsg As String
Dim strTitle As String
Dim tempstr As String
Dim x As Integer, y As Integer
On Error Resume Next
Set wb = Application.Workbooks(wbName)
On Error GoTo 0
strTitle = "Workbook Not Open"
strMsg = "Workbook " + wbName + " isn't open, press 'Retry' to fix."
If wb Is Nothing Then
'The workbook isn't open
Ret_type = MsgBox(strMsg, vbRetryCancel + vbQuestion, strTitle)
Select Case Ret_type
Case 4
'Retry Case
On Error Resume Next
For x = 1 To 2
For y = 1 To 2
Workbooks.Open (FindFilePath(x) + FileEndingManager(wbName, y))
Debug.Print (FindFilePath(x) + FileEndingManager(wbName, y))
Next y
Next x
Case 2
'Cancel Case
MsgBox "You clicked 'CANCEL' button."
End Select
End If
End Sub
TO CLARIFY: This function works when called directly. As in:
Sub TestCheck()
Call CheckOpen("WorkbookName")
End Sub
That's fine. Everything works. However, when I Call this function from a function entered in the actual spreadsheet the MsgBox appears, but it never opens the required workbook.
I don't understand what is going on.
Using Functions (UDFs)
As mentioned in comments #jkpieterse
A function called from a cell cannot do things like opening workbooks
Functions are able to be called from a cell just like Excel's built in functions and they always return something to the cell (even if it's only an error).
For a function to return something, other than an error, it must have a line like
FunctionName = *a value that complies with the function declaration*
Functions are available in auto-complete in Excel, even if they return a #VALUE! error which will occur if you don't set a return as described above. That's probably going to frustrate users!
Any other errors in a UDF will also cause a #VALUE! error and the only way to find them is by stepping through the function using F8. They don't show up at compile time!
So there are at least 2 reasons not to use a function where a sub would suffice.
If you want to change any book or sheet objects then declare a Sub procedure.
Use UDFs sparingly!
To answer your question:
I've tried to refactor your code into a worksheet callable function that will work with a Sub procedure while still using your variables.
I don't know what FindFilePath(x) or FileEndingManager(wbName, Y) do so assume they do work.
Public Function CheckOpen(wbName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Application.Workbooks(wbName)
On Error GoTo 0
If Not wb Is Nothing Then
CheckOpen = True 'the essence of a "Function" - it returns a value!
End If
End Function
Or you could use this alternate function that doesn't require On Error Resume Next
Public Function CheckOpen1(wbName As String) As Boolean
Dim wb As Workbook
For Each wb In Workbooks 'in all the workbooks you have open
If wb.Name = wbName Then
CheckOpen = True 'if not, CheckOpen will remain FALSE
End If
Next
End Function
Then your Sub procedure looks like:
FileEndingManager(wbName, y)
Sub TestCheck()
Dim Ret_type As Integer
Dim strMsg As String
Dim strTitle As String
Dim tempstr As String
Dim x As Integer, y As Integer
If Not CheckOpen("WorkbookName") Then
strTitle = "Workbook Not Open"
strMsg = "WorkbookName isn't open, press 'Retry' to fix."
Ret_type = MsgBox(strMsg, vbRetryCancel + vbQuestion, strTitle)
Select Case Ret_type
Case 4
'Retry Case
On Error Resume Next
For x = 1 To 2
For y = 1 To 2
Workbooks.Open (FindFilePath(x) + FileEndingManager(wbName, y))
Debug.Print (FindFilePath(x) + FileEndingManager(wbName, y))
Next y
Next x
On Error GoTo 0 'end the Resume Next ASAP
'Check if the x, y loop has opened WorkbookName
If Not CheckOpen("WorkbookName") Then 'probably can't be opened
strMsg = "WorkbookName can't be opened! Clicking OK will exit sub."
MsgBox strMsg, vbCritical, strTitle
Exit Sub
End If
Case 2 'Tell user something they know! Not necessary
'Cancel Case
MsgBox "You clicked 'CANCEL' button." 'delete this line and just exit
Exit Sub
End Select
End If
'Haven't exited yet so safe to proceed
'...do things with WorkbookName
End Sub

Can't find a worksheet which exists

I have a worksheet in Excel with the name "Control". I'm receiving a msgbox saying it doesn't exists. After I click on "OK" I get an error of "invalid call of function or procedure and the debugger stops in this function:
Private Sub ClearData(dataSheet As Worksheet)
'On Error Resume Next
'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents
Sheets(dataSheet).UsedRange.ClearContents
End Sub
This function is used to clear the worksheet and the code before 'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents is commented because is raises error and I decided to modify to the line Sheets(dataSheet).UsedRange.ClearContents but the problem persists.
EDIT ClearData is called with this code:
Public Sub Init(rowNr As Integer, copyMap As CopyActionsMap, dataSheet As Worksheet)
m_configRowNr = rowNr
Set m_dataSheet = dataSheet
m_dataRowNr = FindDataRow
m_dataSheet.Cells(m_configRowNr, 1).Select 'select first cell in config row
If (Not m_initialized) Then Set m_columnCopyConfigs = GetColumnCopyConfigs(copyMap) 'also sets m_count
ClearData (m_dataSheet) 'Clean the existing data Now it says "object doenst support this method or property" after this: Private Sub ClearData(dataSheet As Worksheet) Sheets(dataSheet).Cells.Delete
End Sub
As #tigeravatar has mentioned in the comments below your question, you are trying to use a worksheet object as a string variable.
Try changing your code to
Private Sub ClearData(dataSheet As Worksheet)
'On Error Resume Next
'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents
dataSheet.UsedRange.ClearContents
End Sub
If you want to clear the sheet by a specific string name instead, you should change your code to
Private Sub ClearData(dataSheet As String)
'On Error Resume Next
'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents
Sheets(dataSheet).UsedRange.ClearContents
End Sub
And you can then clear the sheet named "Test Sheet" by calling
ClearData "Test Sheet"

How to detect if user select cancel InputBox VBA Excel

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

"Ok" command box in userform

basically I have a userform which I would like to use to enter 2 data into another macro which I already have. The userform is as below:
Basically, I would like the OK button to be clicked and the data in the two boxes will be entered into another macro that I have. It would also be great if the OK button can help in a sense that it will prompt a warning if one of the boxes is not filled up.
So far, I do not have much of a code for this..
Private Sub UserForm_Click()
TextBox1.SetFocus
Sub Enterval()
End Sub
Private Sub TextBox1_Change()
Dim ID As String
ID = UserForm3.TextBox1.Value
End Sub
Private Sub TextBox2_Change()
Dim ID2 As String
ID2 = UserForm3.TextBox2.Value
End Sub
Private Sub OKay_Click()
Enterval
End Sub
Would appreciate any tips and help. Thanks!
My other macro
Private Sub CommandButton1_Click()
Dim Name As String
Dim Problem As Integer
Dim Source As Worksheet, Target As Worksheet
Dim ItsAMatch As Boolean
Dim i As Integer
Set Source = ThisWorkbook.Worksheets("Sheet1")
Set Target = ThisWorkbook.Worksheets("Sheet2")
Name = Source.Range("A3")
Problem = Source.Range("I13")
Do Until IsEmpty(Target.Cells(4 + i, 6)) ' This will loop down through non empty cells from row 5 of column 2
If Target.Cells(4 + i, 6) = Name Then
ItsAMatch = True
Target.Cells(4 + i, 7) = Problem ' This will overwrite your "Problem" value if the name was already in the column
Exit Do
End If
i = i + 1
Loop
' This will write new records if the name hasn't been already found
If ItsAMatch = False Then
Target.Cells(3, 6).End(xlDown).Offset(1, 0) = Name
Target.Cells(4, 6).End(xlDown).Offset(0, 1) = Problem
End If
Set Source = Nothing
Set Target = Nothing
End Sub
Thats the macro i have. As u said, i change the
othermacro
to CommandButton1_Click()
but it doesn't work
Quoting geoB except for one thing: when you .Show your UserForm from a main Sub, you can also .Hide it at the end and the macro that called it will continue its procedures.
Sub Okay_Click()
Dim sID1 As String, sID2 As String
' A little variation
If Me.TextBox1 = "" Or Me.TextBox2 = "" Then
MsgBox "Please fill all the input fields"
Exit Sub
End If
Me.Hide
End Sub
To address your TextBox, you can write in your main Sub UserForm3.TextBox1 for example
There is no need for an Enterval function. Instead, assume the user can read and follow instructions, then test whether that indeed is the case. Note that in your code ID and ID2 will never be used because they exist only within the scope of the subroutines in which they are declared and receive values.
To get started:
Sub Okay_Click()
Dim sID1 As String, sID2 As String
sID1 = UserForm3.TextBox1.Value
sID2 = UserForm3.TextBox2.Value
If Len(sID1 & vbNullString) = 0 Then
MsgBox "Box A is empty"
Exit Sub
End If
If Len(sID2 & vbNullString) = 0 Then
MsgBox "Box B is empty"
Exit Sub
End If
'Now do something with sID1, sID2
otherMacro(sID1, sID2)
End Sub
For your other macro, declare it like this:
Sub otherMacro(ID1, ID2)
...
End Sub
Also, the SetFocus method should occur in the form open event.

Excel Error Handling for range object

I'm working on an Excel user form where the user can input a range. For example, they can put in "B5" and "B20".
I'm trying to do error handling to prevent the user from putting in an incorrect range. For Example, "asdf" and "fdsa".
The following code fails:
Private Sub cmdSend_Click()
Dim beginTerm As String
Dim endTerm As String
beginTerm = TermsBegin.Text
endTerm = TermsEnd.Text
If (IsError(Worksheets("Account Information").Range(beginTerm + ":" + endTerm)) = True) Then
MsgBox "Cell Range is invalid."
Exit Sub
End If
End Sub
I also tried the following:
Private Sub cmdSend_Click()
Dim beginTerm As String
Dim endTerm As String
beginTerm = TermsBegin.Text
endTerm = TermsEnd.Text
Dim myRange As Range
myRange = Worksheets("Account Information").Range(beginTerm + ":" + endTerm)
On Error GoTo ErrHandler
On Error GoTo 0
'other code ...
ErrHandler:
MsgBox "Cell Range is invalid."
Exit Sub
End Sub
My question is how can I handle the case that it fails?
Thanks!
You have to put
On Error GoTo ErrHandler
before the line that could throw the error.
If you need to get a range from a user, I would recommend using Application.InputBox with a Type = 8. This allows the user to select a range from the worksheet.
Check this out:
http://www.ozgrid.com/VBA/inputbox.htm
Also, if you are using a userform, you can also add a command button that will call the Application.InputBox to allow a user to select a range.
Quick example:
Private Sub CommandButton1_Click()
Dim r As Range
On Error Resume Next
Set r = Application.InputBox(Prompt:= _
"Please select a range with your Mouse to be bolded.", _
Title:="SPECIFY RANGE", Type:=8)
If Not r Is Nothing Then MsgBox r.Address
On Error GoTo 0
End Sub

Resources