I am trying to set up an array in Access VBA. I have 40 different parameters to set and setting them using:
'ParameterName1.Visible = True...
'ParameterName2.Visible = True...
is rather clunky. I believe it can be done with an array such as:
'for i = 1 to 40
' ParameterName(i).Visible = True
'Next i
I am a novice in Access vba. I have done some simple coding but this is my first attempt at arrays
Private Sub Form_Load()
Dim NewPN As Boolean
Dim i As Integer
Dim ParameterName(1 To 10) As Variant
Dim ParameterNominal(1 To 10) As Variant
Dim ParameterMinimum(1 To 10) As Variant
Dim ParameterMaximum(1 To 10) As Variant
NewPN = MsgBox("Is This A New Part Number?", vbYesNo, "New Part Number")
If NewPN = True Then
For i = 1 To 10
ParameterName(i).Visible = False
ParameterNominal(i).Visible = False
ParameterMinimum(i).Visible = False
ParameterMaximum(i).Visible = False
Next i
ParaQty = InputBox("How many parameters will be measured?", Parameters?")
For i = 1 To ParaQty
ParameterName(i) = InputBox("Please Enter the Name for Parameter
(Include Units, if applicable) " & i, "Parameter Name?")
ParameterNominal(i) = InputBox("Please Enter the Nominal Value
for Parameter " & i, "Nominal Parameter?")
ParameterMinimum(i) = InputBox("Please Enter the Minimun Value for
Parameter " & i, "Minimum Parameter?")
ParameterMaximum(i) = InputBox("Please Enter the Maximum Value for
Parameter " & i, "Maximum Parameter?")
Next i
End If
End Sub
I get a "object required" error message on the first pass of the for/next loop.
Related
Getting a Run-Time Error 13 type mistmatch error when clicking cancel on a message box.
I tried making the following script to handle if a message box is empty, however upon bug checking, clicking cancel on the message box throws it all out.
Any ideas?
Private Sub ChangeDebtAmounts_Click()
Dim Debt1 As Integer, Debt2 As Integer, Debt3 As Integer, Debt4 As Integer
Dim D1Range As String, D2Range As String, D3Range As String, D4Range As String
D1Range = ActiveSheet.Range("Y15")
D2Range = ActiveSheet.Range("Y16")
D3Range = ActiveSheet.Range("Y17")
D4Range = ActiveSheet.Range("Y18")
Debt1 = InputBox("Please Enter in the account limit for " & D1Range)
If Debt1 = "" Then
MsgBox ("Setting " & D1Range & " to Zero, No Value Entered")
Else
Range("AA15").Value = Debt1 - Range("S58")
End If
End
End Sub
The type mismatch is with the InputBox rather than the MsgBox. To fix it, it is enough to change Dim Debt1 As Integer to Dim Debt1 As Variant. Also, you are using MsgBox as a sub rather than a function so the correct syntax should be
MsgBox "Setting " & D1Range & " to Zero, No Value Entered"
rather than
MsgBox ("Setting " & D1Range & " to Zero, No Value Entered")
In this case the parentheses are harmless, but if you try to give additional arguments to MsgBox while using it as a sub then you will get a syntax error.
Here's a slightly different take on your question. See my comments within the code.
(It's longer just because of the comments; optionally, you can remove any lines of comments, as well as any other blank lines.)
Private Sub ChangeDebtAmounts_Click()
Dim Debt1, Debt2, Debt3, Debt4 'data type "Variant" is assumed
Dim D1Range As String,D2Range As String,D3Range As String,D4Range As String
'by using a "With" statement, you can use "." instead of "ActiveSheet."
With ActiveSheet
D1Range = .Range("Y15")
D2Range = .Range("Y16")
D3Range = .Range("Y17")
D4Range = .Range("Y18")
'I added a title to the dialog and a default value of zero
Debt1=InputBox("Enter the account limit for " & D1Range, "Limit?" ,0)
'Check user response:
If Debt1 = "" Or Debt1 = 0 Then
'User clicked cancel or entered zero.
MsgBox "Setting " & D1Range & " to Zero, No Value Entered"
'I assume your next step is to set the input value to zero:
Debt1 = 0
Else
'you don't need to specify ".Value" in most cases (it's assumed)
'also:by using the "." we're referring to ActiveSheet again.
.Range("AA15") = Debt1 - .Range("S58")
End If
End With '(the end of "With ActiveSheet")
End Sub
A couple other thoughts:
it appears like you're going to use different variables for each InputBox but this is not necessary: you can re-use the same variable in this case, without issue.
ActiveSheet just refers to "whichever worksheet (tab) happens to be open when the code is run". It's a good idea to explicitly refer to a specific worksheet, to prevent potential problems in the future.
For example if your cells such as Y15 are on worksheet Sheet1, you could replace ActiveSheet with Sheets("Sheet1").
Alternate method (loop through all 4 cells)
These methods are for demonstration only - if you already have your solution figured out, stick with that, there's no point in wasting time! These are just to show other ways to do the same thing.
Just for fun, here's another alternate method, that loops through all 4 cells Y15:Y18 and repeats the same MsgBox's.
I wasn't sure what happens with the other 3 values the user enters, so I left those blank.
Private Sub demo_Alternate()
Dim userInput As Variant, arr As Variant, myCell
With Sheets("Sheet1") '<<<<<< change this to actual worksheet name
arr = .Range("Y15:Y18") ' arr(1) to arr(4) are now cell references
For Each myCell In arr
userInput = InputBox("Enter account limit for " & myCell, "Limit?", 0)
If userInput = "" Or userInput = 0 Then 'Cancelled or 0 entered
MsgBox "Setting " & myCell & " to Zero, No Value Entered"
userInput = 0
Else
Select Case Split(myCell.Address, "$")(2)
Case 15 'do what you need to for cell Y15
Range("AA15") = userInput - Range("S58")
Case 16
'do what you need to for cell Y16
Case 17
'do what you need to for cell Y16
Case 18
'do what you need to for cell Y16
End Select
End If
Next myCell 'loop to next cell
End With
End Sub
OR, if all four cells are getting from S58 and put into column AA of the same row, like:
...if your end-goal is the pattern:
AA15 = {Y15 or UserEntry} - S58
AA16 = {Y16 or UserEntry} - S58
AA17 = {Y17 or UserEntry} - S58
AA18 = {Y18 or UserEntry} - S58
...then something like this could work (and is even more compact).
Private Sub demo_Alternate2()
Dim userInput As Variant, arr As Variant, myCell, rowNum As Long
With Sheets("Sheet1") '<<<<<<<<<<<<< change this to actual worksheet name
arr = .Range("Y15:Y18") ' arr(1) to arr(4) are now cell references
For Each myCell In arr
userInput = InputBox("Enter account limit for " & myCell, "Limit?", 0)
If userInput = "" Or userInput = 0 Then 'Cancelled or 0 entered
MsgBox "Setting " & myCell & " to Zero, No Value Entered"
Else
rowNum = Split(myCell.Address, "$")(2)
Range("AA" & rowNum) = userInput - Range("S58")
End If
Next myCell
End With
End Sub
One noteworthy technique used here is the use of an array (arr) to read multiple cell values at once instead of a separate line for each cell input.
arr = .Range("Y15:Y18")
...assigns the four cells to the array so you can refer to the array as if:
arr(1) = Y15
arr(2) = Y16
arr(3) = Y17
arr(4) = Y18
I am trying to output specific error messages in my BeforeSave event. Here is the example message box: http://prntscr.com/jtlxt2.
For every use case the part has to be replaced by the defined error message from the specific test case. If there are multiple issues, all error messages should be printed in one message box. Here are the possible error messages:
1.Missing ID for the blockTemplate
2.The Parameter “ID” must be defined
3.The cell B2 is not allowed to be empty
4.Cell A2 contains an invalid value: “Ids”
5.Font Size must be an integer from 6 till 72
6.Paragraph Spacing Before must be an integer from 6 till 72
Font Size must be an integer from 6 till 72
Table "Column Variants":
7.The Variant IDs QINTRO_VAR1, QINTRO_VAR2 are not compatible with the global ID QUINTRO
8.The Cell C6 is not allowed to be empty. To define null for this value use the minus sign (-).
Here is the code I`ve written so far:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Dim cell As Range
Dim j As String
Dim i As Integer
Dim cellVal As Integer
Dim cellVal2 As Integer
Dim sCellVal As String
Dim a As Variant
Dim Target As Range
Dim arr As Range
Dim rngcheck As Range
Dim rngcheck2 As Range
sCellVal = Range("A2").Value
cellVal = Range("B3").Value
cellVal2 = Range("B4").Value
If Not IsNumeric(cellVal) Then
MsgBox "Only numeric values allowed."
End If
'If Sheets("General Info").Range("A2").Value = "" Then
'Cancel = True
'MsgBox "Save cancelled"
'End If
If Not sCellVal = "ID" Then
Cancel = True
MsgBox "The Parameter “ID” must be defined"
End If
If sCellVal = "" Then
Cancel = True
MsgBox "Missing ID for the blockTemplate"
End If
If sCellVal = "IDs" Then
'Cancel = True
MsgBox "Cell A2 contains an invalid value: “Ids”"
End If
If Not cellVal = (6 < 72) Then
MsgBox "Font Size must be an integer from 6 till 72"
End If
If Not cellVal2 = (6 < 72) Then
MsgBox "Paragraph Spacing Before must be an integer from 6 till 72"
End If
'Set arr = Range("C6:C7")
'If the columns is the eighth
'For Each a In arr
'ActiveSheet.Range("C6:C7").Select
'If Target.Column = 2 And (Target.Row > 5 And Target.Row < 8) Then
Set rngcheck2 = Range("C6:C7")
For Each cell In rngcheck2
If IsEmpty(cell) Then
MsgBox (" The cell" + Target.Address(0, 0)) + "is not allowed to be empty. To define null for this value use the minus sign (-)."
'The Cell C6 is not allowed to be empty. To define null for this value use the minus sign (-).
End If
Next cell
'Next a:
MsgBox (" The Variant IDs QINTRO_VAR1, QINTRO_VAR2 are not compatible with the global ID QUINTRO")
Set rngcheck = Range("B2:B4")
i = 0
For Each cell In rngcheck
If IsEmpty(cell) Then
i = i + 1
j = j & cell.Address & vbNewLine
End If
Next cell
If i = 0 Then Exit Sub
MsgBox "Sorry, you must enter a value in: " & vbNewLine & j
Application.EnableEvents = True
End Sub
I would build a message and then output it only once. Like:
Sub whatever()
Dim mess As String
mess = ""
If Not sCellVal = "ID" Then
Cancel = True
mess = mess & vbCrLf & "The Parameter “ID” must be defined"
End If
If sCellVal = "" Then
Cancel = True
mess = mess & vbCrLf & "Missing ID for the blockTemplate"
End If
' more code
If mess <> "" Then MsgBox mess
End Sub
Create a String called errorString.
Replace your existing "MsgBox " with "errorString=errorString & vbCrLf"
At the end of your routine check to see if there has been any errors (errorString contains something ) and then just msgbx errorString
If len(errorString)>0 Then
errorString = "Please correct the following Errors before continuing" & errorString (or whatever)
endif
Okay... this is not pretty, and it's partly because VBA wants to go line by line... so each error message needs to have its own block, such as:
Dim as as string, b as string, c as string
If sCellVal = "ID" Then a = "The Parameter “ID” must be defined."
If sCellVal = "" Then b = " Missing ID for the blockTemplate."
If sCellVal = "IDs" Then c = " Cell A2 contains an invalid value: “Ids.”"
MsgBox a & b & c 'Note that I put 2 spaces in front of the text above
You will want to group actions that use Cancel = True into one single grouping, and the non Cancel = True blocks into their own grouping. I would recommend the Cancel = True block appear second, so you can collect all possible error messages.
Good day! in my worksheet i have (1) textbox as TextBox1 and 1 button for submit button. I have here sample code that gives splitted text as an output. I just want that if there's duplicated word in textbox1 and the user enters the submit button it will saves to worksheet(DatabaseStorage) and categorize the output from No Duplicated Word and With duplicated Word. Because this two different fields will be needed for some function of the system.
Private Sub CommandButton1_Click()
Call SplitText
End Sub
Sub SplitText()
Dim WArray As Variant
Dim TextString As String
TextString = TextBox1
WArray = Split(TextBox1, " ")
If (TextString = "") Then
MsgBox ("Error: Pls Enter your data")
Else
With Sheets("DatabaseStorage")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(WArray) + IIf(LBound(WArray) = 0, 1, 0)) = Application.Transpose(WArray)
End With
MsgBox ("Successfully inserted")
End If
End Sub
This should accomplish what you need. I loop through the array to check if the given value exists in the "No Duplicates" column. If not, don't print it there.
Any time I encounter a situation where I need to check a single value against a list (ex. check for duplicates, GT/LT, etc.), I consider looping.
Sub SplitText()
Dim WArray As Variant
Dim TextString As String
Dim col_no_dup As Long
Dim col_dup As Long
Dim counter As Integer
Dim sht_database As Worksheet
With ThisWorkbook
Set sht_database = .Sheets("DatabaseStorage")
TextString = LCase(.Sheets("Sheet1").Shapes("Textbox1").DrawingObject.Text)
End With
WArray = Split(TextString, " ") 'load array
If (TextString = "") Then
MsgBox ("Error: Pls Enter your data")
End
Else: End If
'set column locations for duplicates/no duplicates
col_no_dup = 1
col_dup = 2
With sht_database
.Range("A2:B10000").ClearContents 'clear existing data. Change this as needed
'Print whole array into duplicates column
.Cells(Cells.Rows.Count, col_dup).End(xlUp).Offset(1, 0).Resize(UBound(WArray) + IIf(LBound(WArray) = 0, 1, 0)) = Application.Transpose(WArray)
'Loop through array
For i = LBound(WArray) To UBound(WArray)
counter = 0
lrow_no_dup = .Cells(Cells.Rows.Count, col_no_dup).End(xlUp).Row
For n = 1 To lrow_no_dup 'loop through and check each existing value in the no dup column
If .Cells(n, col_no_dup).Value = WArray(i) Then
counter = counter + 1 'account for each occurence
Else: End If
Next n
If counter = 0 Then 'counter = 0 implies the value doesn't exist in the "No Duplicates" column
.Cells(lrow_no_dup + 1, col_no_dup).Value = WArray(i)
Else: End If
Next i
End With
MsgBox ("Successfully inserted")
End Sub
How to get the MS word document checkbox form element associated text value. I am able to extract the value of the checkbox. I tried with bookmark and name properties and found that there is no value associated with bookmark filed of the checkbox. I got the following output. Any thoughts?
Form Fields:
Code:
Sub Test()
Dim strCheckBoxName As String
Dim strCheckBoxValue As String
For i = 1 To ActiveDocument.FormFields.Count
If ActiveDocument.FormFields(i).CheckBox Then
strCheckBoxName = ActiveDocument.FormFields(i).Name
strCheckBoxValue = ActiveDocument.FormFields(i).CheckBox.Value
Debug.Print strCheckBoxName & " = " & strCheckBoxValue
End If
Next
End Sub
Output:
Check1 = True
Check1 = True
Check1 = True
Check1 = False
Check1 = False
Check1 = False
Solution looking for:
A = True
B = True
C = True
D = False
E = False
F = False
EDIT:
By default, when a FormField Check Box is added, it has a Bookmark (name) of Check# where # is sequential starting at 1 until n. Copy and Paste are your friends with FormFields, so one of two things will occur if you go that route to get, say your 1000 FormFields:
1: If you do not alter the value of Bookmark (e.g. default to Check1) and copy and paste that say 1000 times, you end up with 1000 FormFields of Bookmark Check1.
2: If you alter the value of Bookmark (e.g. to A) and copy and past that say 1000 times, only the first FormField retains the Bookmark of A while the rest have a Bookmark that is empty.
You can alter the Check Box default bookmark value (in this case Check1 as a result from copy and paste over and over) to a sequential value such as A1, A2, A3, A4 or Check1, Check2, Check3, etc... by using the following:
Sub Test()
Dim strCheckBoxName As String
Dim strCheckBoxValue As String
For i = 1 To ActiveDocument.formFields.Count
If ActiveDocument.formFields(i).CheckBox Then
strCheckBoxName = ActiveDocument.formFields(i).Name
strCheckBoxValue = ActiveDocument.formFields(i).CheckBox.Value
Debug.Print strCheckBoxName & " = " & strCheckBoxValue
End If
Next
End Sub
Sub RenameCheckBox()
Dim oFields As formFields
Dim oVar As Variant
Dim i As Long
Dim x As Long
x = 0
i = 0
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect
End If
Set oFields = ActiveDocument.formFields
For x = 1 To oFields.Count
oFields(x).Select
Select Case oFields(x).Type
Case wdFieldFormCheckBox
oVar = oFields(x).CheckBox.Value
i = i + 1
With Dialogs(wdDialogFormFieldOptions)
.Name = "Check" & i
.Execute
End With
oFields(x).CheckBox.Value = oVar
Case Else
'Do Nothing
End Select
Next x
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Call Test
End Sub
Context: I'm writing a Word VBA macro that loops through each word in a document, identifies the acronyms, and creates an acronym list as a new document. The next step is to identify whether the acronym is in parentheses (meaning it's likely spelled out) on its first occurrence. So, I'd like to expand the range to find out whether the characters on either side of the word are "(" and ")".
Issue: I can't figure out how to assign the range of the word to a range variable that I can then expand. Using "rngWord = ActiveDocument.Words(k)" (where k is the counter variable) gets the error #91, Object Variable or With block variable not set. So presumably there's a method or property for Words that I'm missing. Based on Microsoft's VBA reference, though, the members of the Words collection are already ranges, so I'm stumped on why I can't assign one to a range variable.
Dim intArrayCount As Integer
Dim booAcroMatchesArray As Boolean
Dim intNextAcro As Integer
Dim strAcros(1000) As String
Dim strContext(1000) As String
Dim booAcroDefined(1000) As Boolean
Dim strTestMessage As String
i = 1
booAcroMatchesArray = False
intNextAcro = 1
For k = 1 To ActiveDocument.Words.Count
strWord = ActiveDocument.Words(k).Text
rngWord = ActiveDocument.Words(k) //The line that's missing something
MsgBox strWord
rngWord.Expand Unit:=wdCharacter
strWordPlus = rngWord
MsgBox strWordPlus
strWord = Trim(strWord)
If strWord = UCase(strWord) And Len(strWord) >= 2 And IsLetter(Left(strWord, 1)) = True Then
'MsgBox ("Word = " & strWord & " and Length = " & Len(strWord))
For intArrayCount = 1 To 1000
If strWord = strAcros(intArrayCount) Then booAcroMatchesArray = True
Next intArrayCount
'MsgBox ("Word = " & strWord & " Match = " & booAcroMatchesArray)
If booAcroMatchesArray = False Then
strAcros(intNextAcro) = strWord
intNextAcro = intNextAcro + 1
End If
booAcroMatchesArray = False
End If
Next k
Object variables need to be assigned using Set. Instead of:
rngWord = ActiveDocument.Words(k)
use
Set rngWord = ActiveDocument.Words(k)
This small sample worked correctly:
Sub WordRangeTest()
Dim rngWord As Range
Set rngWord = ActiveDocument.Words(1)
MsgBox (rngWord.Text)
End Sub