It's me again. ^_^
Can I ask how can I filter a specific record by category? I only know how to filter only one category. Here's my code. Please help me. Thanks!
If txtName.Text = "" Then
MsgBox "Please enter what you want to filter.", vbInformation, "Message Box"
txtName.SetFocus
Else
If Not myRS.EditMode And myRS.BOF = True Then
MsgBox "No record found!", vbCritical, "Search Result"
Else
myRS.Filter = "TL LIKE '" & txtName.Text & "*'"
Set DataGrid1.DataSource = myRS
DataGrid1.Columns(0).Caption = "Work Group"
DataGrid1.Columns(1).Caption = "Team Leader"
DataGrid1.Columns(2).Caption = "Dept Head"
DataGrid1.Columns(3).Caption = "Participants"
DataGrid1.Columns(4).Caption = "Date Created"
DataGrid1.Columns(5).Caption = "Coach"
DataGrid1.Columns(6).Caption = "Problem"
DataGrid1.Columns(7).Caption = "Measure Impacted"
DataGrid1.Columns(8).Caption = "Status"
DataGrid1.Columns(9).Caption = "Where"
DataGrid1.Columns(10).Caption = "When"
DataGrid1.Columns(11).Caption = "How Much/Many"
DataGrid1.Columns(12).Caption = "Who"
Assuming your query to populate myRS looks something like
Select WorkGroup, TL, DeptHead, ...., Category From blah blah
You could change your line to
myRS.Filter = "TL LIKE '" & txtName.Text & "*' OR Category LIKE '" & txtName.Text & "*'"
which would give you both TL and categories that match the txtName, or you could create a new text box in addition to txtName, perhaps txtCategory, and then change the line to
myRS.Filter = "TL LIKE '" & txtName.Text & "*' AND Category LIKE '" & txtCategory.Text & "*'"
add a combo box in the form. and fill it
dim item
Combo1.clear
For Each item In Array("Work Group", "Team Leader", "Dept Head" _
, "Participants", "Date Created", "Coach" _
, "Problem", "Measure Impacted", "Status" _
, "Where", "When", "How Much/Many", "Who")
Combo1.AddItem item
Next
then :
i=combo1.listindex
if(i=-1) then
'ErrorMessageHere
exit sub
end if
myRS.Filter = "[" & myRS.Fields(i).Name & "] LIKE '*" & txtName.Text & "*'"
Related
I have created this code to monitor a folder in case of creation and deletion events.
However, the code I created overwrites always the same cell, whereas I would like to keep track of the changes. Hence I would like all the creation events to be listed in column A and the deletion events to be listed in column B.
Can somebody help me?
Select Case objEventObject.Path_.Class
Case "__InstanceCreationEvent"
MsgBox "A new file was just created: " & objEventObject.TargetInstance.PartComponent
Workbooks("MonitorDirectory").Worksheets("Tabelle1").Range("A2") = objEventObject.TargetInstance.PartComponent
Exit Do
Case "__InstanceDeletionEvent"
MsgBox "A file was just deleted: " & objEventObject.TargetInstance.PartComponent
Workbooks("MonitorDirectory").Worksheets("Tabelle1").Range("B2").End(xlDown).Offset(1, 0) = objEventObject.TargetInstance.PartComponent
Exit Do
End Select
adding two variables x,y as below might work
Select Case objEventObject.Path_.Class
Dim i As Integer
x = Range("a" & Rows.Count).End(xlUp).Row + 1
y = Range("b" & Rows.Count).End(xlUp).Row + 1
Case "__InstanceCreationEvent"
MsgBox "A new file was just created: " & objEventObject.TargetInstance.PartComponent
Workbooks("MonitorDirectory").Worksheets("Tabelle1").Range("A" & x) = objEventObject.TargetInstance.PartComponent
Exit Do
Case "__InstanceDeletionEvent"
MsgBox "A file was just deleted: " & objEventObject.TargetInstance.PartComponent
Workbooks("MonitorDirectory").Worksheets("Tabelle1").Range("B" & y).Offset(1, 0) = objEventObject.TargetInstance.PartComponent
Exit Do
End Select
I am trying to open a form with criteria.
My criteria where I am getting the error.
strCriteria = "WorkID = 3 And
OptOut= -1 And
AppointmentDate = (Last(AppointmentDate))>DateSerial(Year(Date()),Month(Date())-3,1) And
(Last(AppointmentDate))<DateSerial(Year(Date()),Month(Date())-2,0)"
I placed it like this in order to read it easier.
My error number is 3096.
Thank you.
==== Update I give up =======
My code so far.
strSQL = "SELECT tblAppointment.WorkID," & _
"tblCustomer.OptOut," & _
"Last(tblAppointment.AppointmentDate) AS LastAppointmentDate," & _
"tblAppointment.CustomerID," & _
"tblCustomer.Surname," & _
"tblCustomer.Name," & _
"tblCustomer.FatherName," & _
"Last(tblAppointment.AppointmentMemo) AS LastAppointmentMemo" & _
"FROM tblCustomer INNER JOIN tblAppointment ON tblCustomer.CustomerID = tblAppointment.CustomerID " & _
"GROUP BY tblAppointment.WorkID," & _
"tblCustomer.OptOut," & _
"tblAppointment.CustomerID," & _
"tblCustomer.Surname," & _
"tblCustomer.Name," & _
"tblCustomer.FatherName " & _
"HAVING (((tblAppointment.WorkID) = 3) And ((tblCustomer.OptOut) = -1) And " & _
"(LastAppointmentDate > DateSerial(Year(Date()), Month(Date()) - 3, 1) And " & _
"LastAppointmentDate < DateSerial(Year(Date()), Month(Date()) - 2, 0)))" & _
"ORDER BY LastAppointmentDate, " & _
"tblCustomer.Surname," & _
"tblCustomer.Name," & _
"tblCustomer.FatherName;"
I see you are still having trouble. Let's look at the code you have given us.
Your having statement is looking for a field that does not exist on the table. You currently have:
Having (((tblAppointment.WorkID) = 3) And ((tblCustomer.OptOut) = -1) And " & _
"(LastAppointmentDate > DateSerial(Year(Date()), Month(Date()) - 3, 1) And " & _
"LastAppointmentDate < DateSerial(Year(Date()), Month(Date()) - 2, 0)))" & _
Your having clause is looking for LastAppointmentDate on your table. This field does not exist since the field name is AppointmentDate. Change your field name in your having statement to match the field name and it should work. You also have missing parenthesis.
Having (((tblAppointment.WorkID) = 3) AND ((tblCustomer.optout) = -1) AND " & _
"((tblAppointment.AppointmentDate) > DateSerial(Year(Date()), Month(Date()),-3,1)) AND " & _
"((tblAppointment.AppointmentDate) < DateSerial(Year(Date()), Month(Date()),-2,0))) " & _
Try this solution to your having statement. If it does not work, let me know and I'll do more digging.
There isn't much information to go off of with your question, but I'm going to take a stab at it.
I'm assuming you are trying to open a form with the following code:
docmd.openform "FormName",acnormal,,strcriteria
If this is the case, you variable is looking for a last appointment date that hasn't been established or discovered yet. basically, you set a criteria to a field on a form that isn't loaded yet, thus, no information can be used.
You can try a different approach that has done justice for me multiple times and I continue to use this method today.
private sub Eventtrigger()
dim frm as form
dim strSQL as string
strsql = "SELECT * " & _
"FROM TableName " & _
"WHERE (((TableName.workID) = 3 AND (TableName.OptOut) = -1 AND (TableName.AppointmentDate) > DateSerial(year(date()),Month(Date())-3,1) AND (TableName.AppointmentDate) < DateSerial(year(date()),Month(date())-2,0)));"
'Edited since I missed 2 closing parenthesis
Docmd.openform "FormName",acnormal
set frm = [forms]![FormName] 'New form opened
frm.recordsource = strsql
EndCode:
if not frm is nothing then
set frm = nothing
end if
end sub
The above code will allow you to set the recordsource of the form to the newly created query. which the query will filter the results for you.
Or, to fix you variable, Just set your variable as follows:
strcriteria = "WorkID = 3 AND OptOut = -1 AND " & _
"AppointmentDate > DateSerial(Year(date()),Month(date())-3,1) AND " & _
"AppointmentDate < DateSerial(Year(date()),Month(date())-2,0)"
If you need last, use last on AppointmentDate:
Last(AppointmentDate) > DateSerial(Year(date()),Month(Date())-3,1) AND " & _
Last(AppointmentDate) < DateSerial(Year(date()),Month(Date())-2,0)
Let me know if either of these methods/repairs didn't work and I will do more digging.
I have used the spreadsheet provided here to create a ribbon and it worked great as long as it was all about assigning macros to the buttons. However, I wanted to include configuration details in a group of the tab to make it visible all the time without consuming excel sheet real estate. Here is the to-be state:
Group in the custom tab
I have a small macro to select environment and identify the values of various fields shown in the image. Here is what the code looks like:
Sub Change_Configuration()
Dim ConfigButton As Object
Dim Labeling As String
'SelectEnvironment.Show
Environment = "PROD"
If Environment = "QAS" Then
SourceSystem = "ABC"
TargetSystem = "DEF"
SourceSchema = "EFG"
TargetSchema = "GHI"
ElseIf Environment = "PROD" Then
SourceSystem = "IJK"
TargetSystem = "JKL"
SourceSchema = "LMN"
TargetSchema = "NOP"
End If
GetLabel ConfigButton, Labeling 'I do not know what to do here
End Sub
I know that Get Label is the way to do it but I just do not have any clue as to how to achieve what I want to achieve. My current GetLabel callback works fine when I open the excel file and populates default values correctly (The IF part). I tried to include "Else" part to update label but it just does not work.
Original Code:
Sub GetLabel(ByVal control As IRibbonControl, ByRef Labeling)
Select Case control.ID
Case "CustomTab": Labeling = "TEST_RIBBON"
Case "GroupE": Labeling = "Configuration Details"
Case "eButton01": Labeling = "Change Environment"
Case "eButton02": Labeling = "Selected Environment" & " - " & "QAS"
Case "eButton03": Labeling = "Source System" & " - " & "ABC"
Case "eButton04": Labeling = "Source Schema" & " - " & "DEF"
Case "eButton05": Labeling = "Target System" & " - " & "GHI"
Case "eButton06": Labeling = "Target Schema" & " - " & "IJK"
End Select
End Sub
When I open the excel, all labels have values as defined above.
Below is the Modified code (unsuccessful effort to modify to change the label based on Change_Configuration Macro). Please note that modified code also does not throw any error when my workbook is opened and displays values correctly.
Sub GetLabel(ByVal control As IRibbonControl, ByRef Labeling)
If Environment = vbNullString Then
Select Case control.ID
Case "CustomTab": Labeling = "My Tab"
Case "GroupE": Labeling = "Configuration Details"
Case "eButton01": Labeling = "Change Environment"
Case "eButton02": Labeling = "Selected Environment" & " - " & "QAS"
Case "eButton03": Labeling = "Source System" & " - " & "ABC"
Case "eButton04": Labeling = "Source Schema" & " - " & "DEF"
Case "eButton05": Labeling = "Target System" & " - " & "EFG"
Case "eButton06": Labeling = "Target Schema" & " - " & "GHI"
End Select
Else
Select Case ConfigButton
Case "eButton02": Labeling = "Selected Environment" & " - " & Environment
Case "eButton03": Labeling = "Source System" & " - " & SourceSystem
Case "eButton04": Labeling = "Source Schema" & " - " & SourceSchema
Case "eButton05": Labeling = "Target System" & " - " & TargetSystem
Case "eButton06": Labeling = "Target Schema" & " - " & TargetSchema
End Select
End If
End Sub
Your help is greatly appreciated.
-Jevich
Solved it - Had to include onload call back for Ribbon after adjusting XML and then Invalidate function.
too little relevant code to be sure to help you through
but try just changing:
Select Case ConfigButton
to:
Select Case control.ID
and watch what happens...
I tried using the code below to loop through the strDir variable to create 4 different folders in 4 different locations.
It does not create the folders. No errors appear.
Dim i as Integer
JobName = NewJob.Value
If New_Job.JobYes.Value Then
strDir1 = "C:\QTR\" & JobName & " QTR"
strDir2 = "C:\QT\" & JobName & " QT"
strDir3 = "C:\EMAILS\" & JobName & " EMAILS"
strDir4 = "C:\DOCUMENTS\" & JobName & " DOCS"
For i = 1 To 4
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir & i
Else
MsgBox "Directory exists."
End If
Next i
Else
End If
I agree with the array approach but avoid creating blank entries in the array. It has a zero-based index (by default) and strDir(4) actually creates 5 entries; e.g. 0, 1, 2, 3, 4.
First off, either put Option Explicit at the top of the code sheet or go into the VBE's Tools ► Options ► Editor and put a check beside Require Variable Declaration. This will quickly identify the use of undeclared variables like the strDir in your code.
Dim d As Long, strDir As Variant, JobName As String
strDir = Array("C:\QTR\" & JobName & " QTR", _
"C:\QT\" & JobName & " QT", _
"C:\EMAILS\" & JobName & " EMAILS", _
"C:\DOCUMENTS\" & JobName & " DOCS")
For d = LBound(strDir) To UBound(strDir)
If Dir(strDir(d), vbDirectory) = "" Then
MkDir strDir(d)
Else
Debug.Print strDir(d) & " exists."
End If
Next d
The LBound and
UBound functions return the Upper and Lower Boundaries of the array.
Try this code:
Dim i as Integer
Dim strDir(4) as String
JobName = NewJob.Value
If New_Job.JobYes.Value Then
strDir(1) = "C:\QTR\" & JobName & " QTR"
strDir(2) = "C:\QT\" & JobName & " QT"
strDir(3) = "C:\EMAILS\" & JobName & " EMAILS"
strDir(4) = "C:\DOCUMENTS\" & JobName & " DOCS"
For i = 1 To 4
If Dir(strDir(i), vbDirectory) = "" Then
MkDir strDir(i)
Else
MsgBox "Directory exists."
End If
Next i
Else
End If
That will indeed give an error, since its not possible to concatenate the "strDir" & i together, to use that specific parameter. Easiest way to solve this correctly is to skip the loop and use:
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir1
MkDir strDir2
MkDir strDir3
MkDir strDir4
Else
MsgBox "Directory exists."
End If
If you really need to create an enormous amount of directories, lets say > 10, then you might want to use dynamically requesting parameters by name, but if you don't need it, I would not recommend it.
My VBA program processes some operations on an input typed by the user and eventually gives back a result.
At some point, I want to have some userform showing up and "adjusting" the research. For example, if the user typed a state and a city which doesn't fit, it would show "Did you mean city in state ? ". Then, clicking on yes would take into account the modification, clicking no wouldn't change anything.
I have tried this, as found in some tutorials :
city = sMain.Range("J12").Value
province = sMain.Range("J6").Value
provinceSugg = sCurrent.Cells(p, db_column).Value
If province = "" And city <> "" Then
UserForm2.Show
UserForm2.Label1 = "Do you mean : " & city & " in " & provinceSugg
Else
End If
Unfortunately, it doesn't work at all, whatever text I write for Label1 and whatever way of writing I use (Label1.Caption = , Userform2.Label1.Caption = , Label1 = , etc.), still no change.
Thanks for helping me to fix this !
Set the caption before showing the form...like this:
city = sMain.Range("J12").Value
province = sMain.Range("J6").Value
provinceSugg = sCurrent.Cells(p, db_column).Value
If province = "" And city <> "" Then
UserForm2.Label1 = "Do you mean : " & city & " in " & provinceSugg
UserForm2.Show
Else
End If
Use vbModeless ..
If province = "" And city <> "" Then
UserForm2.Show vbModeless
UserForm2.Label1 = "Do you mean : " & city & " in " & provinceSugg
Else
End If