My customer wants to be able to autosum values within a cell. For example, they type in a new value, and this value will be added to the previous one, all within one cell (they don't want another field).
So far, I have 2 forms that will calculate the new value with one they input into the calculator, but it only functions for one cell.
Option Compare Database
Function MyVal(lnIn As Long)
If Len(Me.entry) > 1 Then
Me.entry = Replace(Me.entry, ".", "") & lnIn
'Me.entry = Left(Me.entry, Len(Me.entry)) & "." & Right(Me.entry)
Else
Me.entry = Me.entry & lnIn
End If
End Function
Private Sub calc_Click()
Me.Balance = Me.Balance - (-(Me.entry))
Me.entry = ""
End Sub
Private Sub clear_Click()
Me.entry = ""
End Sub
Private Sub Command16_Click()
Dim MyBalance As Currency
MyBalance = Me.Balance
DoCmd.Close
Forms!frmHours.Form.SetFocus
Forms!frmHours.Form.Balance = MyBalance
End Sub
Private Sub Form_Open(Cancel As Integer)
Me.Balance = OpenArgs
End Sub
Is there a way to move the "selected" cell value into the table I have (replacing the old value), do the calculations, and then move the new value back into the selected cell?
Related
I'm a little stumped.
I've got an MS Access front end application for an SQL Server back end. I have an orders form with a list box that, when selected and a "Notes" button is clicked will open another form of notes. This is a continuous form and has a data source (linked table - a view) from the back end database.
When the notes button is clicked in the main orders form, it passes a filter and an OpenArgs string to the Notes form in this code:
Private Sub cmdItemNotes_Click()
Dim i As Integer
Dim ordLine As Boolean
Dim line As Integer
Dim args As String
If Me.lstOrders.ItemsSelected.count = 1 Then
ordLine = False
With Me.lstOrders
For i = 0 To .ListCount - 1
If .selected(i) Then
If .Column(16, i) = "Orders" Then
ordLine = True
line = .Column(0, i)
End If
End If
Next i
End With
If ordLine Then
args = "txtLineID|" & line & "|txtCurrentUser|" & DLookup("[User]", "tblUsers", "[Current] = -1") & "|txtSortNum|" & _
Nz(DMax("[SortNum]", "dbo_vwInvoiceItemNotesAll", "[LineID] = " & line), 0) + 1 & "|"
DoCmd.OpenForm "frmInvoiceItemNotes", , , "LineID = " & line, , , args
Else
'Potting order notes
End If
Else: MsgBox "Please select one item for notes."
End If
Here is my On Load code for the Notes form:
Private Sub Form_Load()
Dim numPipes As Integer
Dim ArgStr As String
Dim ctl As control
Dim ctlNam As String
Dim val As String
Dim i As Integer
ArgStr = Me.OpenArgs
numPipes = Len(ArgStr) - Len(Replace(ArgStr, "|", ""))
For i = 1 To (numPipes / 2)
ctlNam = Left(ArgStr, InStr(ArgStr, "|") - 1)
Set ctl = Me.Controls(ctlNam)
ArgStr = Right(ArgStr, Len(ArgStr) - (Len(ctlNam) + 1))
val = Left(ArgStr, InStr(ArgStr, "|") - 1)
ctl.Value = val
ArgStr = Right(ArgStr, Len(ArgStr) - (Len(val) + 1))
Next i
End Sub
This code executes fine. The form gets filtered to only see the records (notes) for the line selected back in the orders form.
Because this is editing a table in the back end, I use stored procedures in a pass through query to update the table, not bound controls. The bound controls in the continuous form are for displaying current records only. So... I have an unbound textbox (txtNewNote) in the footer of the form to type a new note, edit an existing note, or post a reply to an existing note.
As stated above, the form filters on load. Everything works great when records show. But when it filters to no records, the txtNewNote textbox behaves quite differently. For instance, I have a combo box to mention other users. Here is the code after update for the combo box:
Private Sub cmbMention_AfterUpdate()
Dim ment As String
If Me.txtNewNote = Mid(Me.txtNewNote.DefaultValue, 2, Len(Me.txtNewNote.DefaultValue) - 2) Then
Me.txtNewNote.Value = ""
End If
If Not IsNull(Me.cmbMention) Then
ment = " #" & Me.cmbMention & " "
If Not InStr(Me.txtNewNote, ment) > 0 Then
Me.txtNewNote = Me.txtNewNote & ment
End If
End If
With Me.txtNewNote
.SetFocus
.SelStart = Len(Nz(Me.txtNewNote, ""))
End With
End Sub
The problem occurs with the line
.SelStart = Len(Nz(Me.txtNewNote, ""))
When there are records to display, it works. When there are no records to display, it throws the Run-time error 2185 "You can't reference a property or method for a control unless the control has the focus."
Ironically, if I omit this line and make the .SetFocus the last line of code in the sub, the control is in focus with the entire text highlighted.
Why would an unbound textbox behave this way just because the filter does not show records?
Thanks!
The following code filters the dropdown list of a combobox in a continuous subform and allows the user to move up and down the dropdown to select data
'Move through the dropdown using up/down arrow keys
Private Sub IngCombo_KeyDown(KeyCode As Integer, Shift As Integer)
Dim MsgBoxResponse As String
Select Case KeyCode
'Tab button is pressed with "" in the field. Access returns a warning message if not dealt with
Case 9 'Tab Button
If Me.IngCombo.Text = "" Then
MsgBoxResponse = MsgBox("Ingredient you entered is not in the list" & vbCrLf & "Would you like to try again?", vbYesNo, "Ingredient not recognised")
Select Case MsgBoxResponse
Case Is = 6
KeyCode = 0
Case Is = 7
KeyCode = 0
Me.Undo
End Select
End If
Case vbKeyDown
Me.IngCombo.Selected(Me.IngCombo.ListIndex + 1) = True
KeyCode = 0
Me.IngCombo.DropDown
Case vbKeyUp
Me.IngCombo.Selected(Me.IngCombo.ListIndex - 1) = True
KeyCode = 0
Me.IngCombo.DropDown
Case vbKeyEscape
Me.IngCombo.Text = ""
Me.Undo
End Select
End Sub
Private Sub IngCombo_KeyUp(KeyCode As Integer, Shift As Integer)
'Filter dropdown to match what the user has typed
'This combo's control source is the IngredientID, but the ID is hidden, hence the SQL selects both the ID and Ingredient text
Dim UserText As String
If Len(Me.IngCombo.Text) > 0 Then
UserText = Me.IngCombo.Text
Me.IngCombo.RowSource = "SELECT IngredientsTbl.IngredientID, IngredientsTbl.Ingredient " _
& "FROM IngredientsTbl WHERE (((IngredientsTbl.Ingredient) LIKE '*" & UserText & "*'));"
If Me.IngCombo.ListCount > 0 Then
Me.IngCombo.DropDown
End If
Else
Me.IngCombo.RowSource = "SELECT IngredientsTbl.IngredientID, IngredientsTbl.Ingredient " _
& "FROM IngredientsTbl;"
End If
End Sub
Private Sub IngCombo_LostFocus()
Me.IngCombo.RowSource = "SELECT IngredientsTbl.IngredientID, IngredientsTbl.Ingredient " _
& "FROM IngredientsTbl ORDER BY IngredientsTbl.Ingredient;"
End Sub
'If user types string that is found by the 'Key Up' routine above but is in the middle of a string i.e. 'milk' is typed and 'buttermilk' is highlighted
'Then pressing tab results in the not in list error
Private Sub IngCombo_NotInList(NewData As String, Response As Integer)
MsgBox "No ingredient matches your search", vbOKOnly, "Nothing Found"
Me.IngCombo = ""
Response = acDataErrContinue
End Sub
This works as intended.
I then add a conditional format, [text19]>50, to the ‘IngCombo’ combobox. This also works as intended but changes the behaviour of the 'IngCombo' combobox. The dropdown no longer appears, and when the user types in the ‘IngCombo’ field of a new record, it has the effect of filtering the text in the ‘IngCombo’ field of the other records of the continuous form. Eg if the user types ‘mint’, then records that contain mint in ‘IngCombo’ are shown, but all the others are blank.
The word ‘calculating’ appears momentarily in the bottom left, replacing the words 'form view' after a key is pressed. I assume this is the conditional formatting doing its work and disrupting the code, as ‘calculating’ does not appear when there is no conditional formatting.
Is there a way of maintaining the functionailty of the code and also having the conditional formating
Update after June7's comment that referenced Allen Browne code.Tried moving code into a Private Sub that is called from the combo's Change event
Private Sub IngCombo_Change()
Dim Cmbo As ComboBox
Set Cmbo = Me.IngCombo
Dim NewText As String
NewText = Cmbo.Text
Call ReloadIngCombo(NewText)
End Sub
Private Sub ReloadIngCombo(UserText As String)
If Len(UserText) > 1 Then
Me.IngCombo.RowSource = "SELECT IngredientsTbl.IngredientID, IngredientsTbl.Ingredient " _
& "FROM IngredientsTbl WHERE (((IngredientsTbl.Ingredient) LIKE '*" & UserText & "*'));"
If Me.IngCombo.ListCount > 0 Then
Me.IngCombo.DropDown
End If
Else
Me.IngCombo.RowSource = "SELECT IngredientsTbl.IngredientID, IngredientsTbl.Ingredient " _
& "FROM IngredientsTbl;"
End If
End Sub
This works as intended. Adding a conditional format to the combobox prevents the dropdowns being shown to the user
I use function to prevent the same record goes into my datagridview but it doesnt work , when i separate the code out then its worked
i tried to seperate the for loop part out then the code work , but i wan to use function to do it so the code look more neater
Private Sub PicFavNote10_Click(sender As Object, e As EventArgs) Handles picFavNote10.Click
If validationDataGrid(lblNameNote10.Text) <> True Then
'if item didn added to the favorite data table yet
'add to favorite table
addTofavorite(lblUserLogin.Text, lblNameNote10.Text, lblDecpNote10.Text, txtPicNote10.Text, "SmartPhone", lblPriceNote10.Text)
End If
lblPriceNote10.Text = FormatCurrency(lblPriceNote10.Text)
End Sub
Private Function validationDataGrid(ByRef data As String) As Boolean
'validation on data grid view
For Each itm As DataGridViewRow In DGTFavTable.Rows 'loop though every item in datagrid
If itm.Cells(0).Value = data Then 'check wherter the text already exist
MsgBox(data & " Already added to your favorite cart")
Return True
Else
Return False
End If
Next
End Function
I expected the MsgBox(data & " Already added to your favorite cart") will excecute but instead the validationDataGrid function return false value even the item is already added to favorite datagridview
Before you loop all rows you need to call this sub as is an efficient workaround to validate new data on DataGridView:
Private Sub ForceGridValidation()
'Get the current cell
Dim currentCell As DataGridViewCell = DGTFavTable.CurrentCell
If currentCell IsNot Nothing Then
Dim colIndex As Integer = currentCell.ColumnIndex
If colIndex < DGTFavTable.Columns.Count - 1 Then
DGTFavTable.CurrentCell = DGTFavTable.Item(colIndex + 1, currentCell.RowIndex)
ElseIf colIndex > 1 Then
DGTFavTable.CurrentCell = DGTFavTable.Item(colIndex - 1, currentCell.RowIndex)
End If
'Set the original cell
DGTFavTable.CurrentCell = currentCell
End If
End Sub
I'm trying reuse some code and thus make controlls in call a function to get different results. The problem seem to be to get references to the different controlls I want to update.
Function populate(num1, num2)
Dim index As Integer
index = ComboBox1.ListIndex
ComboBox2.Clear
Select Case index
Case Is = 0
With ComboBox2
ComboBox2.List = Worksheets("Sheet1").Range("A1:A10").Value
End With
Case Is = 1
With ComboBox2
ComboBox2.List = Worksheets("Sheet2").Range("A1:A10").Value
End With
Case Is = 2
With ComboBox2
ComboBox2.List = Worksheets("Sheet3").Range("A1:A10").Value
End With
End Select
End Function
Private Sub ComboBox1_Change()
Call populate(1, 2)
End Sub
Private Sub ComboBox3_Change()
Call populate(3, 4)
End Sub
Private Sub ComboBox5_Change()
Call populate(5, 6)
End Sub
Naturally, for every combobox I call ( odd numbers ), it should update the values of the 2nd combobox ( even numbers ). But instead of copying the code to each and every odd numbered combobox, I
d like to have some sort of code that actually gets reused by function calls as shown above.
Unfortunatly, I'm unsure of how to make that work in VBA. Needless to say, I'd like it to be something like ( which does not work ) :
Function populate(num1, num2)
Dim index As Integer
index = ComboBox + num1 + .ListIndex
ComboBox + num1 + .Clear
Select Case index
Case Is = 0
With ComboBox + num2
ComboBox + num2 + .List = Worksheets("Sheet1").Range("A1:A10").Value
End With
Case Is = 1
With ComboBox + num2
ComboBox + num2 + .List = Worksheets("Sheet2").Range("A1:A10").Value
End With
Case Is = 2
With ComboBox + num2
ComboBox + num2 + .List = Worksheets("Sheet3").Range("A1:A10").Value
End With
End Select
End Function
Also had a look at the possible duplicated question, tough that did not solve my problem. In fact, even if the subject seems dupicate, I don't think the question is. I'm trying to combine a partial command and a variable in order to create the command I want to use, whilst the possible duplicate seems to want something slightly different ... I might be wrong, but that's what it seemed like to me.
Instead of passing a number to your populate subroutine, pass the ComboBoxes that you wish to process:
Sub populate(cb1 As ComboBox, cb2 As ComboBox)
Dim index As Integer
index = cb1.ListIndex
With cb2
.Clear
Select Case index
Case 0
.List = Worksheets("Sheet1").Range("A1:A10").Value
Case 1
.List = Worksheets("Sheet2").Range("A1:A10").Value
Case 2
.List = Worksheets("Sheet3").Range("A1:A10").Value
End Select
End With
End Sub
Private Sub ComboBox1_Change()
populate ComboBox1, ComboBox2
End Sub
Private Sub ComboBox3_Change()
populate ComboBox3, ComboBox4
End Sub
Private Sub ComboBox5_Change()
populate ComboBox5, ComboBox6
End Sub
You can reference your comboboxes and other controls using the Sheet.Drawingobjects collection, as:
ActiveSheet.DrawingObjects("ComboBox" & num2)
Assuming you have userform comboboxes then your code can shorten down to:
Option Explicit
Sub populate(num1, num2)
Dim shtName As String
shtName = "Sheet" & (Me.Controls("Combobox" & num1).ListIndex + 1)
With Me.Controls("Combobox" & num2)
.Clear
.List = Worksheets(shtName).Range("A1:A10").Value
End With
End Sub
Otherwise, if you have ActiveX Excel comboboxes then it slightly changes to:
Option Explicit
Sub populate(num1, num2)
Dim shtName As String
shtName = "Sheet" & (ActiveSheet.DrawingObjects("ComboBox" & num1).Object.ListIndex + 1)
With ActiveSheet.DrawingObjects("Combobox" & num2).Object
.Clear
.List = Worksheets(shtName).Range("A1:A10").Value
End With
End Sub
So I've been working on this project for a couple of weeks, as I self teach. I've hit a wall, and the community here has been so helpful I come again with a problem.
Basically, I have an input box where a user inputs a name. The name is then displayed in a listbox. The name is also put into an XML table if it is not there already.
There is a button near the list box that allows the user to remove names from the list box. This amends the XML, not removing the name from the table, but adding an end time to that name's child EndTime.
If the user then adds the same name to the input box, the XML gets appended to add another StartTime rather than create a new element.
All of this functions well enough (My code is probably clunky, but it's been working so far.) The problem comes when I try to validate the text box before passing everything through to XML. What I am trying to accomplish is that if the name exists in the listbox on the form (i.e hasn't been deleted by the user) then nothing happens to the XML, the input box is cleared. This is to prevent false timestamps due to a user accidentally typing the same name twice.
Anyhow, I hope that makes sense, I'm tired as hell. The code I've got is as follows:
Private Sub Button1_Click_2(sender As System.Object, e As System.EventArgs) Handles addPlayerButton.Click
playerTypeCheck()
addPlayerXML()
clearAddBox()
End Sub
Private Sub playerTypeCheck()
If playerTypeCBox.SelectedIndex = 0 Then
addMiner()
ElseIf playerTypeCBox.SelectedIndex = 1 Then
addHauler()
ElseIf playerTypeCBox.SelectedIndex = 2 Then
addForeman()
End If
End Sub
Private Sub addMiner()
If minerAddBox.Text = String.Empty Then
Return
End If
If minerListBox.Items.Contains(UCase(minerAddBox.Text)) = True Then
Return
Else : minerListBox.Items.Add(UCase(minerAddBox.Text))
End If
If ComboBox1.Items.Contains(UCase(minerAddBox.Text)) = True Then
Return
Else : ComboBox1.Items.Add(UCase(minerAddBox.Text))
End If
End Sub
Private Sub addPlayerXML()
If System.IO.File.Exists("Miners.xml") Then
Dim xmlSearch As New XmlDocument()
xmlSearch.Load("Miners.xml")
Dim nod As XmlNode = xmlSearch.DocumentElement()
If minerAddBox.Text = "" Then
Return
Else
If playerTypeCBox.SelectedIndex = 0 Then
nod = xmlSearch.SelectSingleNode("/Mining_Op/Miners/Miner[#Name='" + UCase(minerAddBox.Text) + "']")
ElseIf playerTypeCBox.SelectedIndex = 1 Then
nod = xmlSearch.SelectSingleNode("/Mining_Op/Haulers/Hauler[#Name='" + UCase(minerAddBox.Text) + "']")
ElseIf playerTypeCBox.SelectedIndex = 2 Then
nod = xmlSearch.SelectSingleNode("/Mining_Op/Foremen/Foreman[#Name='" + UCase(minerAddBox.Text) + "']")
End If
If nod IsNot Nothing Then
nodeValidatedXML()
Else
Dim docFrag As XmlDocumentFragment = xmlSearch.CreateDocumentFragment()
Dim cr As String = Environment.NewLine
Dim newPlayer As String = ""
Dim nod2 As XmlNode = xmlSearch.SelectSingleNode("/Mining_Op/Miners")
If playerTypeCBox.SelectedIndex = 0 Then
newMinerXML()
ElseIf playerTypeCBox.SelectedIndex = 1 Then
newHaulerXML()
ElseIf playerTypeCBox.SelectedIndex = 2 Then
newForemanXML()
End If
End If
End If
Else
newXML()
End If
End Sub
Private Sub nodeValidatedXML()
If playerTypeCBox.SelectedIndex = 0 Then
minerValidatedXML()
ElseIf playerTypeCBox.SelectedIndex = 1 Then
haulerValidatedXML()
ElseIf playerTypeCBox.SelectedIndex = 2 Then
foremanValidatedXML()
End If
End Sub
Private Sub minerValidatedXML()
If minerListBox.Items.Contains(UCase(minerAddBox.Text)) = False Then
appendMinerTimeXML()
End If
End Sub
Private Sub appendMinerTimeXML()
Dim xmlSearch As New XmlDocument()
xmlSearch.Load("Miners.xml")
Dim docFrag As XmlDocumentFragment = xmlSearch.CreateDocumentFragment()
Dim cr As String = Environment.NewLine
Dim newStartTime As String = Now & ", "
Dim nod2 As XmlNode = xmlSearch.SelectSingleNode("/Mining_Op/Miners/Miner[#Name='" & UCase(minerAddBox.Text) & "']/StartTime")
docFrag.InnerXml = newStartTime
nod2.AppendChild(docFrag)
xmlSearch.Save("Miners.xml")
End Sub
And lastly, the clearAddBox() subroutine
Private Sub clearAddBox()
minerAddBox.Text = ""
End Sub
So, I should point out, that if I rewrite the nodeValidated() Subroutine to something like:
Private Sub nodeValidatedXML()
If playerTypeCBox.SelectedIndex = 0 Then
appendMinerTimeXML()
ElseIf playerTypeCBox.SelectedIndex = 1 Then
appendHaulerTimeXML()
ElseIf playerTypeCBox.SelectedIndex = 2 Then
appendForemanTimeXML()
End If
End Sub
then all of the XML works, except it adds timestamps on names that already exist in the list, which is what i'm trying to avoid. So if I haven't completely pissed you off yet, what is it about the minerValidated() subroutine that is failing to call appendMinerTimeXML()? I feel the problem is either in the minerValidated() sub, or perhaps clearAddBox() is somehow firing and I'm missing it? Thanks for taking the time to slog through this.
Edit: Clarification. The code as I have it right now is failing to append the XML at all. Everything writes fine the first time, but when I remove a name from the list and then re-add, no timestamp is added to the XML.
You need to prevent the user accidentally typing the name twice.(Not sure if you mean adding it twice)
For this I believe you need to clear the minerAddBox.Text in your addminer() if this line is true.
minerListBox.Items.Contains(UCase(minerAddBox.Text)) = True
minerAddBox.Text = ""
Return
Now it will return back to your addplayerXML which will Return to your clearbox(), since you have this in your addplayerXML()
If minerAddBox.Text = "" Then
Return
Now you get to your clearbox() (Which is not really needed now since you cleared the minerAddBox.Text already)
when I remove a name from the list and then re-add, no timestamp is added to the XML.
your minerValidatedXML() is true, because you are not clearing the textbox when you re-add a name to the list box. Or you may need to remove the existing listbox item if it is the same as the textbox
If minerListBox.Items.Contains(UCase(minerAddBox.Text)) = True Then
minerListBox.Items.remove(UCase(minerAddBox.Text))