I'm trying to create a message box that displays various entries for an undetermined number of columns.
I believe I want a loop, but I want the message box to display all the records available in a range and not create a new message box for each item in the range.
I want the message box to look like
Loan Summary(Price, Range, Standard Deviation):
Loan 1: (100, 5, 2)
Loan 2: (102, 4, 3)
and so on but the number of records (loans) will change each time.
I have the below code. How do I add a new line for each record in a range?
For theRep = 1 To wsv.Range("J3").Value
Average1 = Range("loanSummary").Offset(0, theRep)
Range1 = Range("loanSummary").Offset(1, theRep)
StdDev1 = Range("loanSummary").Offset(2, theRep)
MsgBox "Loan Summary (Price, Range, Standard Deviation):" & vbCrLf & vbTab & "Loan 1: " & Format(Average1, "##0.00") & ", " & Format(Range1, "##0.00") & ", " & Format(StdDev1, "##0.00")
Next
Use a string variable to hold the data then after the loop present the string in one MsgBox
Dim str As String
str = "Loan Summary (Price, Range, Standard Deviation):" & vbCrLf & vbTab
For theRep = 1 To wsv.Range("J3").Value
Average1 = Range("loanSummary").Offset(0, theRep)
Range1 = Range("loanSummary").Offset(1, theRep)
StdDev1 = Range("loanSummary").Offset(2, theRep)
str = str & "Loan " & theRep & ": (" & Format(Average1, "##0.00") & ", " & Format(Range1, "##0.00") & ", " & Format(StdDev1, "##0.00") & ")" & vbCrLf & vbTab
Next
MsgBox str
Related
I keep getting the compile error resposne Expected Sub, Function or Property, when trying to run below VBA code. The problem is with the called sub procedure. Any insight as to why will be appreciated.
Result5iii = Result6i - Result4
ResultGi = Result5iii - Range("G2").Value
Range("W3").Value = ("ResultGi")
Range("X3").Value = (" Can Use: [ " & ResultGi & " ]")
Range("Y3").Value = ("2 Nxt will not be " & ResultGi)
Range("Z3").Value = (" 19|15|5ii ")
'Minus1Rule_OriginalsG'
If Result5iii = 5 And Range("G2").Value = 1 And ResultGi = 4. Then
Call Minus1Rule_5OriginalsG
The called Procedure is;
Public Sub Minus1Rule_5OriginalsG()
Dim ResultG As Double, Result5i As Double, Result1 As Double, Result1a As Double
'1. -1 Rule'
'For Originals'
Range("W2").Value = (" 0, 5 [ " & ResultG & " ]")
Range("X2").Value = (" Can Use: 0, 5 [ " & ResultG & " ]")
Range("Y2").Value = ("2 Nxt will not be " & "0, 5" & "Reason: -1 Rule For Originals")
Range("Z2").Value = (Result1 & "|" & Result1a & " 5 - 1" & "|" & "5i ")
End Sub
I'm new to VBA and I'm trying to create a macro that will filter a column on one sheet (Rules) based on the cell value in another which contains the unique values on that column. The unique values are separated by " & ":
Example, a cell may contain the following value: 19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1) & 14.3b(2) & 14.3b(3) & 14.3c & 14.3c(1) & 14.3c(2) & 14.7a
Each of these values has a unique row in column C of the Rules sheet and I want to filter the sheet on that column for all these values.
I have tried the following but it doesn't work:
Sub ArrayFilter()
Dim Rules As String
Dim ArrayFilter As String
Dim arr As Variant
'This is the cell with the values
' e.g 19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1) & 14.3b(2) & 14.3b(3) & 14.3c & 14.3c(1) & 14.3c(2) & 14.7a
Rules = ActiveCell.Offset(0, 38).Range("A1").Value
' I'm trying to convert this to a string for the filter crieria
ArrayFilter = Chr(34) & Replace(Rules, " & ", Chr(34) & ", " & Chr(34)) & Chr(34)
'Now I make this an Array
arr = Array(ArrayFilter)
Sheets("2019 Rules Breakdown").Select
Application.Run "RemoveAndReApplyFilters"
Range("C1").Select
ActiveSheet.ListObjects("Table10").Range.AutoFilter Field:=3, Criteria1:=arr, _
Operator:=xlFilterValues
'This fails, when I look at the filter deployed it is using Equals and just has the arr output.
End Sub
Any help would be gratefully welcomed.
Thanks
The way you try obtaining the array is not appropriate. You can check it in this way:
Dim rules As String, ArrayFilter As String, arr
rules = "19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1)"
ArrayFilter = Chr(34) & Replace(rules, " & ", Chr(34) & ", " & Chr(34)) & Chr(34)
arr = Array(ArrayFilter)
Debug.Print Join(arr, "|"), UBound(arr) 'it will return "19.1", "19.2", "19.2c", "14.3a", "14.3b", "14.3b(1)" 0 .
'meaning an array with a single element, the long string...
End Sub
Now, using the next way, for the same string, the array will look like it should:
Sub testArrayFromString()
Dim rules As String, arr1
rules = "19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1)"
arr1 = Split(rules, " & ")
Debug.Print Join(arr1, "|"), Ubound(arr1) '19.1|19.2|19.2c|14.3a|14.3b|14.3b(1) 5
'proving that it is an array with 6 elements (0 based)
'Being in VBE, press `Ctrl + G` to see the result in `Immediate Window`.
End Sub
As the title says, I am unable to pass a String parameter through an OnAction that occurs when a checkbox is checked. I have successfully passed two integer values to the sub when the checkbox is checked, but now I need to also pass a String parameter (the String is actually the name of the current Worksheet).
This is currently what it looks like:
'Start of for loop which will run from the lower bound of esq to the upper bound.
For i = LBound(esq) To UBound(esq)
'Inserts a row at the specified location, the current row + 1 + the value of i (0 to 12 depending on which run of the loop it is currently on).
workSource.Rows(rowPos + 1 + i).Insert
'Sets cb as equal to the specified cell in the newly inserted row.
Set cb = workSource.CheckBoxes.Add(Cells(rowPos + 1 + i, colPos + 1).Left, Cells(rowPos + 1 + i, colPos + 1).Top, _
Cells(rowPos + 1 + i, colPos + 1).Width, Cells(rowPos + 1 + i, colPos + 1).Height)
'Start of With which sets the attributes of cb.
With cb
'Sets the caption as the current element of esq.
.Caption = esq(i)
'Links the checkbox with the cell directly beneath it.
.LinkedCell = Cells(rowPos + 1 + i, colPos + 1).Address
'Adds a macro which will be activated when it is clicked. The cell's row and column position will be passed as parameters to the macro.
.OnAction = "'ProcessCheckBox " & rowPos + 1 & "," & colPos + 1 + i & "," & currentName & "'"
'.OnAction = "'" & ThisWorkSheet.Name & "'!ProcessCheckBox"
'.OnAction = "'ProcessCheckBox " & rowPos + 1 & "," & colPos + 1 + i & "," & """SES""" & "'"
'.OnAction = "'ProcessCheckBox " & currentName & "'"
'End of With.
End With
'Starts next run of loop and increments i.
Next i
There are three commented out lines of OnAction that I attempted to experiment with in order to get just the string to be passed. Unfortunately, none of them worked. Here is the start of the code for the ProcessCheckBox sub:
'Sub to process when a checkbox has been changed.
Sub ProcessCheckBox(ByVal rowPos As Integer, ByVal colPos As Integer, ByVal currentSheet As String)
'Sub ProcessCheckBox(ByVal currentSheet As String)
MsgBox currentSheet
'Declares a worksheet object named currentSheet.
Dim activeSheet As Worksheet
'Sets currentSheet equal to the active worksheet.
Set activeSheet = ThisWorkbook.Worksheets(currentSheet)
'Set currentSheet = ActiveSheet
After clicking the checkbox, a msgbox appears that is completely blank, and then I run into an error where it says the subscript is out of range.
I gather from this that the sub is being called, the String value is just not being passed along. The string value in the first sub (currentName) does have a value, as I can print it out and use it for calculations just fine.
I think the problem is in the OnAction line itself. It took me a while to figure out how to pass the integer values due to not knowing the correct number of single and double quotes to use. I think it has to do with this, however, all of the other examples I saw passed String values like this. I even experimented by adding or removing quotes just to see if it would work out and nothing.
Other errors I thought it might be: a sub has a limit to how many/large parameters can be passed to it, only parameters of a single type can be passed (either String or Integer). Neither of these make sense because I have encountered many examples that pass much more data across many different types to a sub.
Thank you to the people who answered, but neither of the solutions offered worked. I've been testing the macro and it appears no matter what I do, it will not pass a string as a parameter, either alone or with other parameters. I don't know why.
Here are the two lines in question I have narrowed it down to :
.OnAction = "'ProcessCheckBox " & colPos + 1 & "," & rowPos + 1 + i & ",""" & nameSheet & """'"
And the first line of the sub :
Sub ProcessCheckBox(ByVal colPos As Integer, ByVal rowPos As Integer, ByVal sheetName As String)
Ticking the checkbox gives me an error saying "Argument Not Optional." However, it doesn't allow me to go into debug mode, and it doesn't highlight the specific line either, although I have tested it and believe these two lines to be the problem.
I've given up on figuring VBA's single and double quotes and acknowledge that I never needed anything to be passed as argument that wasn't available in the workbook in which the check box resides. Therefore I can easily get all the information I might want to pass directly from the worksheet.
Where that may not be enough, I also get access to the CheckBox object itself. All my needs for arguments can be satisfied completely without any quotation marks.
Private Sub CheckBox1_Click()
Dim ChkBox As Shape
Set ChkBox = ActiveSheet.Shapes(Application.Caller)
MsgBox ChkBox.Parent.Name & vbcr & _
ChkBox.OLEFormat.Object.Name
End Sub
Here are 3 possible solutions for your problem, all involving the Application.Caller.
Please run this code on your project.
Sub CheckBox1_Click()
Dim ChkBox As Shape
Dim WsName As String, Rpos As Long, Cpos As Long
Dim Cell As Range
' Solution 1
WsName = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Parent.Name
MsgBox "You already know how to pass the cell coordinates" & vbCr & _
"Just get the Sheet name from here:" & vbCr & _
"Sheet name is """ & WsName & """"
Set ChkBox = ActiveSheet.Shapes(Application.Caller)
' Solution 2
Set Cell = ChkBox.OLEFormat.Object.TopLeftCell
Rpos = Cell.Row
Cpos = Cell.Column
WsName = Cell.Worksheet.Name
MsgBox "Solution 2" & vbCr & _
"The checkbox Top Left is aligned with the" & vbCr & _
"Linked Cell's Top Left:-" & vbCr & _
"Row number = " & Rpos & vbCr & _
"Column number = " & Cpos & vbCr & _
"Worksheet name = " & WsName & vbCr & _
"If Alignment of underlying cell and TopLeft" & vbCr & _
"isn't perfect, modify the placement in your other code." & vbCr & _
"Here is the TopLeft address:-" & vbCr & _
"TopLeftCell address = " & Cell.Address
' Solution 3
Set Cell = Range(ChkBox.OLEFormat.Object.LinkedCell)
Rpos = Cell.Row
Cpos = Cell.Column
WsName = Cell.Worksheet.Name
MsgBox "Solution 3" & vbCr & _
"Get the information directly from the Linked Cell." & vbCr & _
"(This is probably the one you are interested in):-" & vbCr & _
"Row number = " & Rpos & vbCr & _
"Column number = " & Cpos & vbCr & _
"Worksheet name = " & WsName & vbCr & _
"This method might fail if the linked cell" & vbCr & _
"is altered, perhaps manually."
End Sub
I am running into an issue that is driving me crazy. I have two FOR loops in my macro that each have a counter to keep track of how many times a certain process was performed. The counters work great and at the end of the loop contain the correct numbers. The next thing I have to do is to format the counts into a five digit number with leading zeros. I have tried this using two different approaches (see below).
cCount = String(5 - Len(cTemp), "0") & cTemp
mCount = String(5 - Len(mTemp), "0") & mTemp
or
cCount = Format(cTemp, "00000")
mCount = Format(mTemp, "00000")
The problem is with the second counter. As I step through it, the first format formula works, but the second line does not, regardless of which version above that I use. Now here is the thing, if, while I am still in the macro, I go and change the name of mCount to anything else, for example mCnt, and then move the macro step back up to reprocess that line, it will correctly format the variable. But it isn't the name, because if I then run the macro again using mCnt, it will do the same thing. I can change it back to mCount and it will work.
All variables are dimmed as Integers. An example of what I am looking for would be if mTemp is 15, then mCount would be 00015. However, mCount is just coming back as 15. cCount is working fine.
The fact that everything is correct and that I can make it work if I pause the macro, change the variable name, and reprocess the line, has got me completely at a loss as to what the issue is.
Sub MakePay()
Dim strFileToOpen As String
Dim payDate, payTab, payCheckTemp, payCheck, payAccTemp As String
Dim payAcc, payAmount, payTotalC, payTotalM As String
Dim savePath As String
Dim payFileNameCLP, payFileNameMF As String
Dim payString1, payString2, payString3, payString4, payString5, payString6 As String
Dim payString7, payString8, payString9 As String
Dim rCnt, i, j, cTemp, cCount, mTemp, mCount As Integer
Dim payTotalMTemp, payAmountTemp, payTotalCTemp As Double
' Set date
payDate = Format(Now(), "yyyymmddhhmmss")
' Ask for check number and format to field length
payCheckTemp = InputBox("Please enter the check number.")
payCheck = payCheckTemp & String(15 - Len(payCheckTemp), " ")
' Create file names and open text files for writing
payFileNameCLP = "CLP_" & payDate & "_01.txt"
payFileNameMF = "MDF_" & payDate & "_01.txt"
savePath = Environ("USERPROFILE") & "\Desktop\"
Open savePath & payFileNameCLP For Output As #1
Open savePath & payFileNameMF For Output As #2
' Build header rows and print them
payString1 = "100"
payString2 = "200 C"
Print #1, payString1
Print #1, payString2
Print #2, payString1
Print #2, payString2
' reset counters for number of claims and total dollar amounts in files
cTemp = 0
mTemp = 0
payTotalCTemp = 0
payTotalMTemp = 0
For i = 1 To Sheets.Count
' Process the Clearpoint tab
If Left(Sheets(i).Name, 3) = "CLE" Then
Sheets(i).Activate
rCnt = Cells(Rows.Count, 1).End(xlUp).Row
For j = 3 To (rCnt - 1)
' Read accession # and format it for field length
payAccTemp = Cells(j, 3).Value
payAcc = payAccTemp & String(17 - Len(payAccTemp), " ")
' Read payment amount, if $0, skip
payAmountTemp = Format(Cells(j, 5).Value2, "#,###.00")
If payAmountTemp = "" Then
GoTo SkipCDL
End If
' Add payment to total Clearpoint payments
payTotalCTemp = payTotalCTemp + payAmountTemp
' Format payment by deleting decimal and then format to field length
payAmount = Format(payAmountTemp * 100, "0000000;-000000")
' Build payment strings and print them
payString3 = "400" & String(10, " ") & payAcc & payCheck
payString4 = "450" & String(10, " ") & payAcc & String(150, " ") & payAmount
payString5 = "500" & String(10, " ") & payAcc & String(73, " ") & payAmount
Print #1, payString3
Print #1, payString4
Print #1, payString5
' Increase Clearpoint patient count
cTemp = cTemp + 1
SkipCDL:
Next j
' Process Medfusion tab
ElseIf Left(Sheets(i).Name, 3) = "MED" Then
Sheets(i).Activate
rCnt = Cells(Rows.Count, 1).End(xlUp).Row
For j = 3 To (rCnt - 1)
' Read accession # and format it for field length
payAccTemp = Cells(j, 3).Value
payAcc = payAccTemp & String(17 - Len(payAccTemp), " ")
' Read payment amount, if $0, skip
payAmountTemp = Format(Cells(j, 5).Value2, "#,###.00")
If payAmountTemp = "" Then
GoTo SkipMDF
End If
' Add payment to total Medfusion payments
payTotalMTemp = payTotalMTemp + payAmountTemp
' Format payment by deleting decimal and then format to field length
payAmount = Format(payAmountTemp * 100, "0000000;-000000")
' Build payment strings and print them
payString3 = "400" & String(10, " ") & payAcc & payCheck
payString4 = "450" & String(10, " ") & payAcc & String(150, " ") & payAmount
payString5 = "500" & String(10, " ") & payAcc & String(73, " ") & payAmount
Print #2, payString3
Print #2, payString4
Print #2, payString5
' Increase Medfusion count
mTemp = mTemp + 1
SkipMDF:
Next j
End If
Next i
' Format patient counter and total payment to field length
cCount = Format(cTemp, "00000")
mCount = Format(mTemp, "00000")
payTotalC = Format(payTotalCTemp * 100, "000000000;-00000000")
payTotalM = Format(payTotalMTemp * 100, "000000000;-00000000")
' Build footer strings and print them
payString6 = "800" & String(26, " ") & "9999" & cCount & String(131, " ") & payTotalC
payString7 = "800" & String(26, " ") & "9999" & mCount & String(131, " ") & payTotalM
payString8 = "900" & String(57, " ") & "099990" & cCount & String(154, " ") & String(2, "0") & payTotalC
payString9 = "900" & String(57, " ") & "099990" & mCount & String(154, " ") & String(2, "0") & payTotalM
Print #1, payString6
Print #2, payString7
Print #1, payString8
Print #2, payString9
' Close all files
Application.DisplayAlerts = False
Close #1
Close #2
Application.DisplayAlerts = True
End Sub
The issue is with how the variables are declared.
In VBA/classic vb, all declarations should be on their own line OR have the correct data type specified, otherwise you risk accidentally creating a Variant data type, which can masquerade as any other data type, which the VB engine has rules for determining the type.
See https://msdn.microsoft.com/en-us/library/56ht941f(v=vs.90).aspx
Also, whenever coding in VBA make sure Option Explicit is declared at the top of any new code module. It will save you loads of pain in the future.
Also, you are trying to push String formatting into an Integer, which cannot happen.
So...
Option Explicit
.....
'Dim i, j as Integer 'BAD i is a variant, j is an integer
Dim i As Integer
Dim j As Integer 'GOOD both are Integers
'OR
Dim x As Integer, y as Integer 'I believe this will work too
dim displayI as String
i = 23
displayI = Format(i, "00000")
In your code why not just format inline?
payString6 = "800" & String(26, " ") & "9999" & Format(cCount,"00000") & String(131, " ") & payTotalC
pretty new with VBA and there doesnt seem to be much help around the internet as I understand it is relativley old.
I am trying to use a Macro to submit data from an excel sheet into a SQL server DB.
Basically the click of a button, should pull the required data from the cells, which then put the data in the correct columns in my DB.
It is not submitting the data properley, for example one cell has the number '2' in it and it is submitting the number '0' into my database.
Can anyone advise?
Code below.
' Create the connection string.
sConnString = "provider=xxx; Data Source=xx-xxx; Initial Catalog=xxx;User ID= xx; Password=xxx;": MsgBox "Connection Succesful"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim val As String
val = Range("D5").Value
' Open the connection and execute.
conn.Open sConnString
Dim item As String
item = "INSERT INTO [Industrial].[dbo].[Header]("
item = item & " [server_name]"
item = item & " ,[date]"
item = item & " ,[amendee]"
item = item & " ,[ip_address]"
item = item & " ,[physical_location]"
item = item & " ,[host_name]"
item = item & " ,[is_it_contact]"
item = item & " ,[businesscontact]"
item = item & " ,[businessdependencies]"
item = item & " ,[backup_strategy_in_place]"
item = item & " ,[physorvirt]"
item = item & " )Values("
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
item = item & " '" & val & "'"
conn.Execute item
End Sub
You may want to check the data types and the constraints on your DB table. Its possible depending on your db type (MySQL, MSSQL, or Postgres) that if you're trying to put in a 'true' instead of true for a boolean column, it will default to 0.
Secondly, I notice is that you're placing the same value into every column.
Might I suggest an array. (intro to excel vba Arrays: http://excelvbatutor.com/vba_chp21.htm)
The below code will work assuming your data is on Sheet1 and like so...
A B (columns)
1
2 column_name_B "fifty"
3 column_name_C 10
4 column_name_D myName
(rows)
Sub testeroo()
Dim myArray(2, 2)
Dim x As Integer
Sheets("Sheet1").Activate
For x = 2 To 4
myArray(x - 2, 0) = Cells(x, 1).Value 'gets the title
myArray(x - 2, 1) = Cells(x, 2).Value 'gets the value
Next x
Then you could do a loop through the array to get your SQL statement.
End Sub