I'm trying to generate a query dynamically using textbox values from my Bookings form to update only those values that were entered by the user.
I am using the following code:
Dim str As String
str = "UPDATE Bookings SET "
Dim first As Integer = 1
For Each x As Control In Me.Controls
If x.GetType Is GetType(TextBox) Then
If first = 1 Then
first = 2
Else
str &= ","
End If
If x.Tag = 1 Then
str = str & x.Name & " = #" & x.Name
End If
End If
Next
But it is generating the query like this:
Update Bookings SET ,,booking_date = #booking_date,,,,,cust_name = #cust_name where bookingID = #bookingID
Or if I want to update just 1 field it generates this:
Update Bookings SET ,,,,,,,cust_name = #cust_name where bookingID = #bookingID
Dim str As String
str = "UPDATE Bookings SET "
Dim comma As string = ""
For Each x As Control In Me.Controls
If x.GetType Is GetType(TextBox) Then
If x.Tag = 1 Then
str &= comma & x.Name & " = #" & x.Name
comma = ","
End If
End If
Next
And here is the One line answer.
Dim str = "UPDATE Bookings SET " & String.Join(",", (From _E In Controls.OfType(Of Control)() Where _E.GetType() Is GetType(TextBox) AndAlso _E.Tag = "1" Select _E.Name).ToList())
Related
Here as you can see I'm not using combox_click because it is declared above and the current one is another function to be called without clicking, here my question is how do I get the pre-selected value from the combo box without clicking on the box?
Public Sub ComDep_Change()
Dim sQuery As String
Dim oRS As New ADODB.Recordset
Dim rsPR As New ADODB.Recordset
Dim dateFormat As String
Dim sPONO As String
Dim sPOAmt As String
'oRS.Open "po_receiveable", PRCnn, adOpenDynamic, adLockOptimistic
combVal = ComDep.List(ComDep.ListIndex)
If Not combVal = "ALL_DEPT" And frmMain.OptLatestCN.Value = True Then
'MsgBox ("Works")
dateFormat = "#" + CStr(Day(Now)) + "/" + CStr(Month(Now)) + "/" + CStr(Year(Now) - 3) + "#"
sQuery = "select * from CN_Request_Header where dept = '" & combVal & "' and requestdate >= " & dateFormat & ""
' sQuery = "Select PO_No, PO_Requestor, PO_Req_Dept, PO_Status, PO_Approval_M, PO_Approval_GM, PO_Approval_D, PO_HRApproval, VC_No, TH_Sup_Inv, PO_HR_Rmk, PO_Req_Date, PO_SupplierName, PO_OverallAmt from PR_INFO where PO_Req_Dept = '" & combVal & "'"
' MsgBox ("Result" & sQuery)
rsPR.Open sQuery, PRCnn, adOpenDynamic, adLockOptimistic
lvwCreditNote.ListItems.Clear
Do While Not rsPR.EOF
Set listitem = frmMain.lvwCreditNote.ListItems.Add
With listitem
.Text = CStr(Trim(rsPR!requestID))
.SubItems(1) = Trim(rsPR!requestID)
.SubItems(2) = Format(CStr(rsPR!requestdate), "dd-mmm-yy")
.SubItems(3) = Trim(rsPR!createby)
.SubItems(4) = Trim(rsPR!dept)
.SubItems(5) = Trim(rsPR!reqstatus)
If IsNull(rsPR!custName) Then
.SubItems(6) = ""
Else
.SubItems(6) = Trim(rsPR!custName)
End If
If IsNull(rsPR!cnamt) Then
.SubItems(7) = "0.00"
Else
.SubItems(7) = Format(rsPR!cnamt, "#,###,##0.00")
End If
You would get the currently SELECTED element in a combobox
by using the SELECTEDINDEX Property
If nothing is selected then you get the value -1 returned to you.
If something is selected it will be in the range 0 to Combox.Count - 1
To get the text for the selected item
You could use something like...
Dim SelIndex as Integer
Dim SelText As String
'
SelIndex = MyCombobox.SelectedIndex
If (SelIndex >= 0) AND (SelIndex <= MyCombobox.Count - 1) Then
SelText = MyCombobox.List(Index)
Else
'Nothing was selected in the combobox
End If
I am just wondering how i can skip over an error if the array is not full? For example, 1 loop goes over whether the array has a first and last name, if there is no last name i would like the script to continue.
FullName = ActiveSheet.Cells(37, ii).Value
Name = Split(FullName, " ")
For intCount = LBound(Name) To UBound(Name)
sData.Range("C" & iii).Value = Name(0)
sData.Range("D" & iii).Value = Name(1)
Next
If Name(1) is empty then how can the code continue?
Since the two columns are consecutive, you can just paste the array in-place, using Range.Resize to dump the array across as many columns as needed - the only thing to watch for is if Name can contain more than a single space:
FullName = ActiveSheet.Cells(37, ii).Value
Name = Split(FullName, " ")
If UBound(Name) <= 1 Then
sData.Range("C" & iii).Resize(, UBound(Name) + 1).Value = Name
Else
'there was more than one space...
End If
If you want to avoid using On Error Resume Next, you can try this:
FullName = ActiveSheet.Cells(37, ii).Value
Name = Split(FullName, " ")
If Len(Join(Name)) > 0 Then
sData.Range("C" & iii).Value = Name(0)
sData.Range("D" & iii).Value = Name(1)
End If
which was originally posted here. Join essentially reverts to the FullName value but without the space. Alternatively, you could just use If InStr(1, FullName, " ", vbBinaryCompare) > 0 Then.
With some test values
Option Explicit
Sub test()
Dim ii As Long
Dim iii As Long
ii = 2
iii = 3
Dim FullName As String
Dim Name() As String
With ActiveSheet
FullName = .Cells(37, ii).Value
If InStrRev(FullName, " ", -1) > 0 Then 'space present
Name = Split(FullName, " ")
If UBound(Name) > 1 Then Exit Sub 'there was more than one space present. Handling this was not specified so exit sub.
.Range("C" & iii).Value = Name(0)
.Range("D" & iii).Value = Name(1)
Else
.Range("C" & iii).Value = FullName
.Range("D" & iii).Value = vbNullString
End If
End With
End Sub
Where a DataTable has the following Columns
Account Number (Integer) (Unique)
Debit (Decimal)
Credit (Decimal)
Selected (Boolean)
There may be several rows with the same account number and either a Debit Entry or a Credit Entry. What I am attempting to do is match up the debits and credits where they add up to the same value and mark them as selected by iterating through all the rows. Any idea on the best method to achieve this?
Thanks
e.g.
SQL
strSQL = "SELECT A_Sales_Ledger.Transaction_ID as 'Transaction', "
strSQL += "Customers.Cust_No as 'Acct', "
strSQL += "Customers.Cust_Name as 'Name', "
strSQL += "Customers.Add1 as 'Unit', "
strSQL += "A_Sales_Ledger.Debit as 'Debit', "
strSQL += "A_Sales_Ledger.Credit as 'Credit', "
strSQL += "A_Sales_Ledger.Document_Date as 'Date', "
strSQL += "A_Sales_Ledger.S_Description as 'Description' "
strSQL += "FROM A_Sales_Ledger "
strSQL += "JOIN Customers ON Customers.Customer_ID = A_Sales_Ledger.Customer_ID "
strSQL += "WHERE A_Sales_Ledger.Paid = 'N' "
strSQL += "ORDER BY Customers.Cust_No"
This may not be the best solution but it does seem to work...
I'm making three passes though the DataTable
Pass one - if the total of the debits equals the total of the credits for each customer mark them as selected
Pass two - Add the total of the credits for the customer and iterate though the debits until the same value is achieved and mark them as selected
Pass three - mop up any remaining credit entries that match a debit entry for the same customer...
For Each Row As DataRow In BalanceDT.Rows
Dim vAcct As String = Row("Acct")
Dim vDebits As Decimal = BalanceDT.Compute("SUM(Debit)", "Acct = '" & vAcct & "'")
Dim vCredits As Decimal = BalanceDT.Compute("SUM(Credit)", "Acct = '" & vAcct & "'")
If vDebits = vCredits Then
Row("Selected") = True
End If
Next
Dim CurrentCust As String = ""
Dim TransactionDT As New DataTable
Dim ExitFor As Boolean = False
With TransactionDT.Columns
.Add("ID", GetType(Integer))
End With
For Each Row As DataRow In BalanceDT.Rows
Dim vAcct As String = Row("Acct")
ExitFor = False
TransactionDT.Rows.Clear()
If Not CurrentCust = vAcct Then
Dim vCredits As Decimal = BalanceDT.Compute("SUM(Credit)", "Acct = '" & vAcct & "'")
Dim vSelected() As DataRow = BalanceDT.Select("Acct = '" & vAcct & "'", Nothing)
For Each SubRow As DataRow In vSelected
If SubRow("Selected") = False Then
vCredits -= SubRow("Debit")
With TransactionDT.Rows
.Add(SubRow("Transaction"))
End With
If vCredits = 0 Then
ExitFor = True
Exit For
End If
End If
Next
If ExitFor = True Then
For Each SubRow As DataRow In vSelected
If SubRow("Credit") > 0 Then
SubRow("Selected") = True
End If
If SubRow("Debit") > 0 Then
For Each CustomerRow As DataRow In TransactionDT.Rows
If CustomerRow("ID") = SubRow("Transaction") Then
SubRow("Selected") = True
End If
Next
End If
Next
End If
End If
CurrentCust = vAcct
Next
For Each Row As DataRow In BalanceDT.Rows
Dim vAcct As String = Row("Acct")
If Not CurrentCust = vAcct Then
Dim vSelected() As DataRow = BalanceDT.Select("Acct = '" & vAcct & "' AND Selected = 'False'", "Credit")
For Each SubRow As DataRow In vSelected
If SubRow("Selected") = False Then
Dim vCredit As Decimal = SubRow("Credit")
For Each CustomerRow In vSelected
If CustomerRow("Selected") = False Then
Dim vDebit As Decimal = CustomerRow("Debit")
If Not vDebit = 0 And Not vCredit = 0 Then
If vDebit = vCredit Then
With TransactionDT.Rows
CustomerRow("Selected") = True
SubRow("Selected") = True
End With
Exit For
End If
End If
End If
Next
End If
Next
End If
CurrentCust = vAcct
Next
I'm using VB 2010 Express to access a database in .mdb format.
I want to find the row that contains a specific string of characters and numbers, so I wrote this while loop. I'm using If statement to make sure the loop doesn't exceed the maximum rows ( MaxRows ) and throw an error. The result it keeps giving : " No record found " even though string does exist in the database. What am I doing wrong?
notes: inc is used to increment the row. message box is only to view the variables values
Code:
Dim lpn As String
Dim lpn2 As String
inc = 0
lpn = TextBox5.Text
lpn2 = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(7)
MsgBox(lpn & " " & lpn2 & " ")
While lpn <> lpn2
If inc <> MaxRows - 1 Then
inc = inc + 1
lpn2 = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(7)
MsgBox(lpn & " " & lpn2)
Else
MsgBox("No record found.")
Exit While
End If
End While
TextBox1.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(1)
TextBox2.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(2)
TextBox3.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(3)
TextBox4.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(4)
ComboBox1.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(5)
ComboBox2.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(6)
TextBox5.Text = ds.Tables("RegisteredCarsDataSet").Rows(inc).Item(7)
In Excel 2003 I'm getting a Runtime error 1004: "application-defined or object-defined error" on the last line of this code (commandtext = abc)
Sub SCommandTxt()
Dim abc as string
abc = Sheets("Totals").PivotTables("PivotTable2").PivotCache.CommandText
Sheets("Totals").PivotTables("PivotTable2").PivotCache.CommandText = abc
End Sub
This isn't really what I'm trying to do, but not knowing what is causing an error in something as simple as this is driving me up a wall. The Pivot table at hand is an ODBC connection. The following code was run before this code and works fine. All I really want to do is change the query dynamically based on the changing range "WhereFilters". The below query works alright, but I'd prefer not to have to unhide and select the sheet and go through the pivotwizard if I can just change the commandText directly (though based on the errors I'm getting maybe not... Though others seem to think the above is possible, so I don't know why it isn't working for me):
Sub UpdatePvt()
Dim DBDir As String, DBName As String, SortType As String, Size As String
Dim QueryArry1(0 To 100) As String, rng As Range, x As Integer
DBDir = "C:\Documents and Settings\jt\"
DBName = "DatabaseExample.mdb"
If Range("ComboResult1") = 1 Then
SortType = "TDollars"
Sheets("Totals").PivotTables("PivotTable1").PivotFields("DIV_ID").AutoSort _
xlDescending, "Sum of Dollars"
Sheets("Totals").PivotTables("PivotTable2").PivotFields("DIV_ID").AutoSort _
xlDescending, "Sum of Dollars"
Else
SortType = "TCounts"
Sheets("Totals").PivotTables("PivotTable1").PivotFields("DIV_ID").AutoSort _
xlDescending, "Sum of Counts"
Sheets("Totals").PivotTables("PivotTable2").PivotFields("DIV_ID").AutoSort _
xlDescending, "Sum of Counts"
End If
If Range("ComboResult2") = 1 Then
Size = "Total"
ElseIf Range("ComboParOUT") = 2 Then
Size = "Small"
Else
Size = "Large"
End If
QueryArry1(0) = "SELECT Top 500 C.* "
QueryArry1(1) = "FROM Final03 C "
x = 2
If Not (Range("NoFilters")) Then
QueryArry1(x) = "INNER JOIN (Select DIV_ID FROM FullLookup WHERE "
x = x + 1
For Each rng In Range("WhereFilters")
QueryArry1(x) = rng.Value
x = x + 1
Next rng
QueryArry1(x) = "GROUP BY DIV_ID) E ON C.DIV_ID = E.DIV_ID "
x = x + 1
End If
QueryArry1(x) = "WHERE C.EntitySize = '" & Size & "' "
QueryArry1(x + 1) = "ORDER BY C." & SortType & " DESC "
'Example Query Results:
'SELECT Top 500 C.* FROM Final03 C INNER JOIN (Select DIV_ID FROM FullLookup WHERE Year = 2008 and State = 'MN' and Type = 'RST44' GROUP BY DIV_ID) E ON C.DIV_ID = E.DIV_ID WHERE C.EntitySize = 'Large' ORDER BY C.TCounts DESC
Sheets("Totals").Visible = xlSheetVisible
Sheets("Totals").Select
Sheets("Totals").PivotTables("PivotTable1").DataBodyRange.Select
Sheets("Totals").PivotTableWizard SourceType:=xlExternal, _
SourceData:=QueryArry1, _
Connection:=Array( _
Array("ODBC;DSN=MS Access Database;DBQ=" & DBDir & "\" & DBName & ";"), _
Array("DefaultDir=" & DBDir & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;") _
)
Sheets("Totals").PivotTables("PivotTable2").DataBodyRange.Select
Sheets("Totals").PivotTableWizard _
SourceType:=xlPivotTable, _
SourceData:="PivotTable1"
Sheets("Totals").Visible = xlSheetHidden
End Sub
Thanks
Your problem appears to be the exact one described here:
Limitation of PivotCache.CommandText property
How long is the string you're trying to set as CommandText?