I have the following user input set up in excel vba. The function when called asks the user to input a single number no greater than 9999, or two numbers in the format XXXX-XXXX where two numbers are separated by a dash. In that case, the numbers cannot be greater than 9999 in either case, or at least shouldn't.
The goal is to return either a single number (IE 50) or a range (IE low value is 50,high value is 75). Currently as set up it should be returning an array, where the first position is the low value, and the second position is high value. Or, if the user only enters one number, it should return that one number in the first position of an array.
Currently it checks that A) user has entered in a number, B) the number is not greater than 4 digits long.
Unfortunately it is not returning an array, it is returning an error. Subscript out of range.
Also, are there any other likely user inputs that should be checked for here? The application is not going to be widely used by people, but I'd like to minimize potential errors as well.
Public Function getUserInput() As Variant
'this function gets a user input from an input box and puts it out into the proper format
Dim inputString As String
Dim numArr() As String
Dim i As Long
' On Error GoTo NotValidInput
inputString = Trim(InputBox("Enter the rows you'd like to print"))
'has the user entered a dash into their user input
If InStr(inputString, "-") > 0 Then
numArr() = Split(inputString, "-")
If UBound(numArr) <> 1 Then
GoTo NotValidNumberFormat
End If
If (IsNumeric(numArr(0)) And Len(numArr(0)) <= 4) And (IsNumeric(numArr(1)) And Len(numArr(1)) <= 4) Then
getUserInput = numArr
Exit Function
Else
GoTo NotValidNumberFormat
End If
'no dash
'60
Else
If (IsNumeric(CInt(inputString))) And Len(inputString) <= 4 Then
getUserInput = numArr
Exit Function
Else
GoTo NotValidNumberFormat
End If
End If
Exit Function
NotValidNumberFormat:
'if the conversion failed, return error
MsgBox ("Please enter the number in a valid format - either a single number no larger than 9999 or two numbers no larger than 9999 separated by only one dash (IE XX-XX)")
getUserInput = -1
End Function
this should do:
Public Function getUserInput() As Variant
'this function gets a user input from an input box and puts it out into the proper format
Dim numArr As Variant
Dim goOn As Boolean
Do
numArr = Split(WorksheetFunction.Trim(InputBox("Enter the rows you'd like to print in the format 'nnnn' or 'nnnn-mmmm'")), "-")
Select Case UBound(numArr)
Case 0
goOn = Format(numArr(0), "0000") Like "####"
Case 1
goOn = Format(numArr(0), "0000") Like "####" And Format(numArr(1), "0000") Like "####"
End Select
If Not goOn Then MsgBox "Please enter the number in a valid format - either a single number no larger than 9999 or two numbers no larger than 9999 separated by only one dash (ex: XX-XX)"
Loop While Not goOn
getUserInput = numArr
End Function
Related
When multiple PowerPoint slide numbers are entered in the input box (ex: 3, 5, 6), I want to create a macro that selects the slides of the entered number, but an error occurs.
Sub test()
Dim strresponse2 As String
Dim iresponse2 As String
strresponse2 = InputBox("page number" & vbCr & "ex) 2,4,11,5")
If IsNumeric(strresponse2) Then
iresponse2 = strresponse2
End If
ActiveWindow.Selection.Unselect
ActivePresentation.slides.Range(Array(iresponse2)).Select
'error here
'How to fix it so it doesn't get an error
'ActivePresentation.Slides.Range(Array(2, 4, 11,5)).Select
'no error
End Sub
Several issues here.
a) If you enter 2, 4, 5, the check for IsNumeric(strresponse2) will fail because the function tries to convert the whole string into one single number.
b) Array(iresponse2) will not convert the string into an array (of 3 numbers). It will convert the single string 2, 4, 5 into an string array with 1 (not 3) member.
In your case, you can use the Split-function to split the input string into an array of strings.
c) If you want to access the slides by number, the input needs to be of a numeric type, not of string (even if the strings contain numbers). You will need to convert the string array into a numeric array (if you pass a string or an array of strings as parameter, VBA will look for members with the name, not the index).
Have a look to the following piece of code and check if it does what you need - it's only half tested (as I have no Powerpoint VBA available, only Excel, but the priniple is the same)
Dim answer As String
answer = InputBox("page number" & vbCr & "ex) 2,4,11,5")
Dim pagesS() As String
pagesS = Split(answer, ",") ' Split the answer into an array of strings.
ReDim pagesN(0 To UBound(pagesS)) As Long ' Create an empty numeric array
Dim countS As Long, countN As Long
For countS = 0 To UBound(pagesS) ' Loop over all strings
If IsNumeric(pagesS(countS)) Then ' String is Numeric
Dim pageNo As Long
pageNo = Val(pagesS(countS)) ' Convert string to number
If pageNo > 0 And pageNo <= ActivePresentation.slides.Count Then
pagesN(countN) = pageNo ' When number is within valid range, copy it
countN = countN + 1 ' Count the number of valid page numbers
End If
End If
Next countS
If countN > 0 Then ' At least one number found
ReDim Preserve pagesN(0 To countN - 1) ' Get rid of unused elements
ActivePresentation.Slides.Range(pagesN).Select
End If
I am trying to grab a cell check if it has decimal places and remove them then place a specific format in a cell depending on how many characters there are in the number, the len function returns null, and the instr function works but when passed to a variable returns null. Thank you to anyone who can help. At the end of the first if function I print the results of the 3 variables not working to the immediate window to verify, with the Debug.Print command please go to view menu and activate immediate window to watch.
Function cnvtDta()
ActiveSheet.Select
Data1 = Range("data").Value
Dim rslt As String
rslt = Data1
Set myrng = Range("data")
Dim wot, sowot
'Find decimal place in cell
dot = myrng.Find(".", myrng)
If dot = True Then
'if decimal place strip remainders and decimal point
Dim pos, res
pos = InStr(1, rslt, ".")
res = Left(rslt, pos)
sowot = Len(res)
End If
Debug.Print res
Debug.Print sowot
Debug.Print pos
'Return specific formats to cell
'thank you kindly to anyone who can spare the time to genuinely help
End Function
So basically there's a couple of parts to your question.
Check if value has decimals. Here's one way to do it (based on values, not on strings)
Function DoesCellContainDecimals(inputRange As Range) As Boolean
Dim tolerance As Double
tolerance = 0.0001
If Not IsNumeric(inputRange.Value2) Then
'invalid argument
DoesCellContainDecimals = False
Exit Function
End If
If (Abs(Fix(inputRange.Value2) - inputRange.Value2) < tolerance) Then
'value does not have meaningful decimals
DoesCellContainDecimals = False
Else
'value has meaningful decimals
DoesCellContainDecimals = True
End If
End Function
Get the integer part of a number. There are two functions. Similar but different behavior with negative numbers (make sure if the value is a number first):
Int(6.5) '6
Fix(6.5) '6
Int(-6.5) '-7
Fix(-6.5) '-6
Format a number. Either turn it to string or set Range.NumberFormat property:
Format(6500000,"# ### ###") '6 500 000
Range("A1").NumberFormat = "# ### ##0" 'same effect as above but only when displaying in that cell.
I have a comment field with cells containing text like this:
Cancelled by user at 2018-01-03 03:11:57 without charge
I want to get the date and time information, but it may not always be in the 3rd/4th from last spaces, otherwise I might try to do some sort of complicated split of the cell. Is there an "in cell" way extract the date time information? Or will this need a VBA script? I prefer the former, but I'm trying to make a macro to simplify my life anyway, so VBA would work too.
I'd propose the following formula:
=MID(A1,FIND("at 20",A1)+3,19)
This would require that the date is always preceded by the word 'at' and the date string starts with 20.
You can try this function. It splits the string checking for items that have the first letter numeric, and builds a result string of just the date information.
Public Function ParseForDate(sCell As String) As String
Dim vSplit As Variant
Dim nIndex As Integer
Dim sResult As String
vSplit = Split(sCell, " ")
For nIndex = 0 To UBound(vSplit)
If IsNumeric(Left$(vSplit(nIndex), 1)) Then
sResult = sResult & vSplit(nIndex) & " "
End If
Next
ParseForDate = Trim$(sResult)
End Function
If you wanted to use it in a formula it would look something like this:
=ParseForDate(A1)
To use it in a VBA routine:
Dim s as String
s = ParseForDate(Range("A1"))
Non-VBA solution: (this is assuming the date format is always the same for all cells)
= MAX(IFERROR(DATEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
+MAX(IFERROR(TIMEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
Note this is an array formula, so you must press Ctrl+Shift+Enter instead of just Enter when typing this formula.
You will obviously then need to format the cell as a date and time, but this formula gets the numerical value that Excel uses for its internal date and time system.
Using a regex will enable you to fetch the date and time, irrespective of its placement in the string. The following solution will work if the date and time are of the same format as shown in the example string.
Code:
Sub getDateTime()
Dim objReg, matches, str
str = Sheet1.Cells(1, 1).Value 'Change this as per your requirements
Set objReg = CreateObject("vbscript.regexp")
objReg.Global = True
objReg.Pattern = "\d{4}(?:-\d{2}){2}\s*\d{2}(?::\d{2}){2}"
If objReg.test(str) Then
Set matches = objReg.Execute(str)
strResult = matches.Item(0)
MsgBox strResult
End If
End Sub
Click for Regex Demo
Regex Explanation:
\d{4} - matches 4 digits representing the year
(?:-\d{2}){2} - matches - followed by 2 digits. {2} in the end repeats this match 2 times. Once for getting MM and the next time for DD
\s* - matches 0+ whitespaces to match the space between the Date and Time
\d{2} - matches 2 digits representing the HH
(?::\d{2}){2} - matches : followed by 2 digits. The {2} in the end repeats this match 2 times. First time for matching the :MM and the next time for matching the :SS
Screenshots:
Output:
This will be good for about 90 years (using cell C3 for example):
Sub GetDate()
Dim s As String
s = Range("C3").Comment.Text
arr = Split(s, " ")
For i = LBound(arr) To UBound(arr)
If Left(arr(i), 2) = "20" Then
msg = arr(i) & " " & arr(i + 1)
MsgBox msg
Exit Sub
End If
Next i
End Sub
I am trying to add the data in the two cells of the excel sheet but even if the excel cell is of the type number it does not add up the cells. It seems that there is space infornt of the number that it does not add....image is below.
Is there a vba code to remove this space from each of the cell if its presesnt.
I have exported the excel from a pdf.
Excel will attempt to convert any value to a number if you apply an operator to it, and this conversion will handle spaces. So you can use =A1*1 or A1+0 to convert a value in A1 to a number, or something like this within a function =SUM(IFERROR(A1*1,0)).
That kind of implicit conversion automatically performs a trim(). You can also do this conversion explicitly by using the funciton N(), or NumberValue() for newer versions of Excel. However, as others have pointed out, many characters won't be automatically handled and you may need to use Substitute() to remove them. For instance, Substitute(A1,160,"") for a non-breaking space, a prime suspect because of its prevalence in html. The Clean() function can give you a shortcut by doing this for a bunch of characters that are known to be problematic, but it's not comprehensive and you still need to add your own handling for a non-breaking space. You can find the ASCII code for any specific characters that are grieving you by using the Code() function... for instance Code(Mid(A1,1,1))
Character Handling UDF
The UDF below gives flexibility to the character handling approach by allowing multiple characters to be removed from every cell in a range, and produces a result that can be used as an argument. For example, Sum(RemoveChar(A1:A5,160)) would remove all non-breaking spaces from the range being summed. Multiple characters can removed by being specified in either a range or array, for example Sum(RemoveChar(A1:A5,B1:B3)) or Sum(RemoveChar(A1:A5,{160,150})).
Function RemoveChar(R As Range, ParamArray ChVal() As Variant)
Dim x As Variant
Dim ResVals() As Variant
ReDim ResVals(1 To R.Count)
'Loop through range
For j = 1 To R.Count
x = R(j).Value2
If x <> Empty Then
'Try treating character argument as array
'If that fails, then try treating as Range
On Error Resume Next
For i = 1 To UBound(ChVal(0))
x = Replace(x, Chr(ChVal(0)(i)), "")
Next
If Err = 92 Then
Err.Clear
For Each Rng In ChVal(0)
x = Replace(x, Chr(Rng.Value2), "")
Next
End If
Err.Raise (Err)
On Error GoTo 0
'If numeric then convert to number
'so that numbers will be treated as such
'when array is passed as an argument
If IsNumeric(x) Then
ResVals(j) = Val(x)
Else
ResVals(j) = x
End If
End If
Next
'Return array of type variant
RemoveChar = ResVals
End Function
Numeric Verifying UDF
The drawback with replacing characters is that it's not comprehensive. If you want something that's more of a catch-all, then perhaps something like this.
Function GetNumValues(R As Range)
Dim c, temp As String
Dim NumVals() As Double
ReDim NumVals(1 To R.Count)
'Loop through range
For j = 1 To R.Count
'Loop through characters
'Allow for initial short-circuit if already numeric
For i = 1 To Len(R(j).Value2)
c = Mid(R(j).Value2, i, 1)
'If character is valid for number then include in temp string
If IsNumeric(c) Or c = Application.DecimalSeparator Or c = Application.ThousandsSeparator Then
temp = temp + c
End If
Next
'Assign temp string to array of type double
'Use Val() function to convert string to number
NumVals(j) = Val(temp)
'Reset temp string
temp = Empty
Next
'Return array of type double
GetNumValues = NumVals
End Function
I have the following code to check values entered into two input boxes, if both values are zero then the MsgBox should display "Stop!" (I will change this later to exiting the sub but I am using a MsgBox for testing)
From testing I've seen these results:
A zero in both strings produces the expected message box.
A non zero in the first string followed by any non zero value in the second string does nothing (as expected).
A zero in the first string followed by a second string value equal to or greater than 10 produces the message box (unexpected).
I've also noticed that if the second string is 6-9 it is displayed as x.00000000000001%. I think this is a floating point issue and could be related? This behaviour occurs without the IF... InStr function too.
Option Explicit
Sub Models()
Dim MinPer As String, MaxPer As String, Frmula As String
Dim Data As Worksheet, Results As Worksheet
Set Data = Sheets("Data")
Set Results = Sheets("Results")
Application.ScreenUpdating = False
MinPer = 1 - InputBox("Enter Minimum Threshold Percentage, do not include the % symbol", _
"Minimum?") / 100
MaxPer = 1 + InputBox("Enter Maximum Threshold Percentage, do not include the % symbol", _
"Maximum?") / 100
If (InStr(MinPer, "0") = 0) And (InStr(MaxPer, "0") = 0) Then
MsgBox "STOP!"
End If
' Remainder of code...
This is the most interesting problem I've come across so far in VBA and welcome any discussion about it.
Edit: I use this code to display on screen the paramaters for the end-user to see. Hence how I noticed the .00000000001% issue:
.Range("D2").Value = "Min is " & 100 - MinPer * 100 & "%"
.Range("D3").Value = "Max is " & MaxPer * 100 - 100 & "%"
Two things
1) Declare MinPer, MaxPer as Long or a Double and not a String as you are storing outputs from a calculation
2) Don't directly use the InputBox in the calculations. Store them in a variable and then if the input is valid then use them in the calculation
Dim MinPer As Double, MaxPer As Double, Frmula As String
Dim Data As Worksheet, Results As Worksheet
Dim n1 As Long, n2 As Long
Set Data = Sheets("Data")
Set Results = Sheets("Results")
Application.ScreenUpdating = False
On Error Resume Next
n1 = Application.InputBox(Prompt:="Enter Minimum Threshold Percentage, do not include the % symbol", _
Title:="Minimum?", Type:=1)
On Error GoTo 0
If n1 = False Then
MsgBox "User cancelled"
Exit Sub
End If
On Error Resume Next
n2 = Application.InputBox(Prompt:="Enter Maximum Threshold Percentage, do not include the % symbol", _
Title:="Maximum?", Type:=1)
On Error GoTo 0
If n2 = False Then
MsgBox "User cancelled"
Exit Sub
End If
If n1 = 0 And n2 = 0 Then
MsgBox "STOP!"
End If
MinPer = 1 - (Val(n1) / 100)
MaxPer = 1 + (Val(n2) / 100)
This is because the number "10" has a "0" in the string (second character) so both evaluate to true.
Try this instead:
If (MinPer = "0") And (MaxPer = "0") Then
MsgBox "STOP!"
End If
For additional control save the user input (MinPer , MaxPer) and THEN text them for validity before performing nay mathematical operations on them.
InStr(MinPer, "0") is just checking to see whether the string contains a zero
character.
You need to convert the string value to an integer. Use the IsNumeric and CInt functions
to do that. See this URL:
vba convert string to int if string is a number
Dim minPerINT as Integer
Dim maxPerINT as Integer
If IsNumeric(minPer) Then
minPerINT = CInt(minPer)
Else
minPerINT = 0
End If
If IsNumeric(maxPer) Then
maxPerINT = CInt(maxPer)
Else
maxPerINT = 0
End If
If minPerINT = 0 and maxPerINT=0 Then
MsgBox "STOP!"
End If
Depending on what data can be entered It may also be a good idea to check if the length
of the data is zero using the len() function.