I'm trying to make an query that will generate column with unique row number generated incrementally. My table with data don't have any unique value.
I was trying to get Gustav script, but I only manage to get it return 1 in every row.
Public Function RowCounter( _
ByVal strKey As String, _
ByVal booReset As Boolean, _
Optional ByVal strGroupKey As String) _
As Long
' Builds consecutive RowIDs in select, append or create query
' with the possibility of automatic reset.
' Optionally a grouping key can be passed to reset the row count
' for every group key.
'
' Usage (typical select query):
' SELECT RowCounter(CStr([ID]),False) AS RowID, *
' FROM tblSomeTable
' WHERE (RowCounter(CStr([ID]),False) <> RowCounter("",True));
'
' Usage (with group key):
' SELECT RowCounter(CStr([ID]),False,CStr[GroupID])) AS RowID, *
' FROM tblSomeTable
' WHERE (RowCounter(CStr([ID]),False) <> RowCounter("",True));
'
' The Where statement resets the counter when the query is run
' and is needed for browsing a select query.
'
' Usage (typical append query, manual reset):
' 1. Reset counter manually:
' Call RowCounter(vbNullString, False)
' 2. Run query:
' INSERT INTO tblTemp ( RowID )
' SELECT RowCounter(CStr([ID]),False) AS RowID, *
' FROM tblSomeTable;
'
' Usage (typical append query, automatic reset):
' INSERT INTO tblTemp ( RowID )
' SELECT RowCounter(CStr([ID]),False) AS RowID, *
' FROM tblSomeTable
' WHERE (RowCounter("",True)=0);
'
' 2002-04-13. Cactus Data ApS. CPH
' 2002-09-09. Str() sometimes fails. Replaced with CStr().
' 2005-10-21. Str(col.Count + 1) reduced to col.Count + 1.
' 2008-02-27. Optional group parameter added.
' 2010-08-04. Corrected that group key missed first row in group.
Static col As New Collection
Static strGroup As String
On Error GoTo Err_RowCounter
If booReset = True Then
Set col = Nothing
ElseIf strGroup <> strGroupKey Then
Set col = Nothing
strGroup = strGroupKey
col.Add 1, strKey
Else
col.Add col.Count + 1, strKey
End If
RowCounter = col(strKey)
Exit_RowCounter:
Exit Function
Err_RowCounter:
Select Case Err
Case 457
' Key is present.
Resume Next
Case Else
' Some other error.
Resume Exit_RowCounter
End Select
End Function
Sql query that I'm trying to get working is like this:
SELECT RowCounter("Query1",False) AS RowID, *
FROM Query1
WHERE (RowCounter("Query1",False)<>RowCounter("",True));
What am I missing to get this to work?
You are passing a fixed string as the parameter - and this gets No. 1.
Use the ID of the records of the query, like:
SELECT RowCounter(CStr([ID]),False) AS RowID, *
Related
I need to write a rank query, but i have to do it on access.
How do I translate the following query?
PERIODO,
SUM(IMP_ENTRATE_ATT) AS TOT_ENTRATE,
RANK89 OVER(PARTITION BY PERIODO ORDER BY TOT_ENTRATE DESC)AS RANK
FROM ENTRATE
ORDER BY RANK ```
e.i.
COMPANY | MONTH | REVENUES
'''
a | 01 | 100
b | 02 | 55
a | 02 | 230
c | 03 | 25
a | 01 | 70
b | 02 | 100
'''
I need to find the sum(revenues) per month per company
Access SQL has no ranking functions. You can use my function RowRank from GitHub: VBA.RowNumbers:
' Returns, by the value of a field, the rank of one or more records of a table or query.
' Supports all five common ranking strategies (methods).
'
' Source:
' WikiPedia: https://en.wikipedia.org/wiki/Ranking
'
' Supports ranking of descending as well as ascending values.
' Any ranking will require one table scan only.
' For strategy Ordinal, a a second field with a subvalue must be used.
'
' Typical usage (table Products of Northwind sample database):
'
' SELECT Products.*, RowRank("[Standard Cost]","[Products]",[Standard Cost]) AS Rank
' FROM Products
' ORDER BY Products.[Standard Cost] DESC;
'
' Typical usage for strategy Ordinal with a second field ([Product Code]) holding the subvalues:
'
' SELECT Products.*, RowRank("[Standard Cost],[Product Code]","[Products]",[Standard Cost],[Product Code],2) AS Ordinal
' FROM Products
' ORDER BY Products.[Standard Cost] DESC;
'
' To obtain a rank, the first three parameters must be passed.
' Four parameters is required for strategy Ordinal to be returned properly.
' The remaining parameters are optional.
'
' The ranking will be cached until Order is changed or RowRank is called to clear the cache.
' To clear the cache, call RowRank with no parameters:
'
' RowRank
'
' Parameters:
'
' Expression: One field name for other strategies than Ordinal, two field names for this.
' Domain: Table or query name.
' Value: The values to rank.
' SubValue: The subvalues to rank when using strategy Ordinal.
' Strategy: Strategy for the ranking.
' Order: The order by which to rank the values (and subvalues).
'
' 2019-07-11. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RowRank( _
Optional ByVal Expression As String, _
Optional ByVal Domain As String, _
Optional ByVal Value As Variant, _
Optional ByVal SubValue As Variant, _
Optional ByVal Strategy As ApRankingStrategy = ApRankingStrategy.apStandardCompetition, _
Optional ByVal Order As ApRankingOrder = ApRankingOrder.apDescending) _
As Double
Const SqlMask1 As String = "Select Top 1 {0} From {1}"
Const SqlMask As String = "Select {0} From {1} Order By 1 {2}"
Const SqlOrder As String = ",{0} {1}"
Const OrderAsc As String = "Asc"
Const OrderDesc As String = "Desc"
Const FirstStrategy As Integer = ApRankingStrategy.apDense
Const LastStrategy As Integer = ApRankingStrategy.apFractional
' Expected error codes to accept.
Const CannotAddKey As Long = 457
Const CannotFindKey As Long = 5
' Uncommon character string to assemble Key and SubKey as a compound key.
Const KeySeparator As String = "¤§¤"
' Array of the collections for the five strategies.
Static Ranks(FirstStrategy To LastStrategy) As Collection
' The last sort order used.
Static LastOrder As ApRankingOrder
Dim Records As DAO.Recordset
' Array to hold the rank for each strategy.
Dim Rank(FirstStrategy To LastStrategy) As Double
Dim Item As Integer
Dim Sql As String
Dim SortCount As Integer
Dim SortOrder As String
Dim LastKey As String
Dim Key As String
Dim SubKey As String
Dim Dupes As Integer
Dim Delta As Long
Dim ThisStrategy As ApRankingStrategy
On Error GoTo Err_RowRank
If Expression = "" Then
' Erase the collections of keys.
For Item = LBound(Ranks) To UBound(Ranks)
Set Ranks(Item) = Nothing
Next
Else
If LastOrder <> Order Or Ranks(FirstStrategy) Is Nothing Then
' Initialize the collections and reset their ranks.
For Item = LBound(Ranks) To UBound(Ranks)
Set Ranks(Item) = New Collection
Rank(Item) = 0
Next
' Build order clause.
Sql = Replace(Replace(SqlMask1, "{0}", Expression), "{1}", Domain)
SortCount = CurrentDb.OpenRecordset(Sql, dbReadOnly).Fields.Count
If Order = ApRankingOrder.apDescending Then
' Descending sorting (default).
SortOrder = OrderDesc
Else
' Ascending sorting.
SortOrder = OrderAsc
End If
LastOrder = Order
' Build SQL.
Sql = Replace(Replace(Replace(SqlMask, "{0}", Expression), "{1}", Domain), "{2}", SortOrder)
' Add a second sort field, if present.
If SortCount >= 2 Then
Sql = Sql & Replace(Replace(SqlOrder, "{0}", 2), "{1}", SortOrder)
End If
' Open ordered recordset.
Set Records = CurrentDb.OpenRecordset(Sql, dbReadOnly)
' Loop the recordset once while creating all the collections of ranks.
While Not Records.EOF
Key = CStr(Nz(Records.Fields(0).Value))
SubKey = ""
' Create the sub key if a second field is present.
If SortCount > 1 Then
SubKey = CStr(Nz(Records.Fields(1).Value))
End If
If LastKey <> Key Then
' Add new entries.
For ThisStrategy = FirstStrategy To LastStrategy
Select Case ThisStrategy
Case ApRankingStrategy.apDense
Rank(ThisStrategy) = Rank(ThisStrategy) + 1
Case ApRankingStrategy.apStandardCompetition
Rank(ThisStrategy) = Rank(ThisStrategy) + 1 + Dupes
Dupes = 0
Case ApRankingStrategy.apModifiedCompetition
Rank(ThisStrategy) = Rank(ThisStrategy) + 1
Case ApRankingStrategy.apOrdinal
Rank(ThisStrategy) = Rank(ThisStrategy) + 1
' Add entry using both Key and SubKey
Ranks(ThisStrategy).Add Rank(ThisStrategy), Key & KeySeparator & SubKey
Case ApRankingStrategy.apFractional
Rank(ThisStrategy) = Rank(ThisStrategy) + 1 + Delta / 2
Delta = 0
End Select
If ThisStrategy = ApRankingStrategy.apOrdinal Then
' Key with SubKey has been added above for this strategy.
Else
' Add key for all other strategies.
Ranks(ThisStrategy).Add Rank(ThisStrategy), Key
End If
Next
LastKey = Key
Else
' Modify entries and/or counters for those strategies that require this for a repeated key.
For ThisStrategy = FirstStrategy To LastStrategy
Select Case ThisStrategy
Case ApRankingStrategy.apDense
Case ApRankingStrategy.apStandardCompetition
Dupes = Dupes + 1
Case ApRankingStrategy.apModifiedCompetition
Rank(ThisStrategy) = Rank(ThisStrategy) + 1
Ranks(ThisStrategy).Remove Key
Ranks(ThisStrategy).Add Rank(ThisStrategy), Key
Case ApRankingStrategy.apOrdinal
Rank(ThisStrategy) = Rank(ThisStrategy) + 1
' Will fail for a repeated value of SubKey.
Ranks(ThisStrategy).Add Rank(ThisStrategy), Key & KeySeparator & SubKey
Case ApRankingStrategy.apFractional
Rank(ThisStrategy) = Rank(ThisStrategy) + 0.5
Ranks(ThisStrategy).Remove Key
Ranks(ThisStrategy).Add Rank(ThisStrategy), Key
Delta = Delta + 1
End Select
Next
End If
Records.MoveNext
Wend
Records.Close
End If
' Retrieve the rank for the current strategy.
If Strategy = ApRankingStrategy.apOrdinal Then
' Use both Value and SubValue.
Key = CStr(Nz(Value)) & KeySeparator & CStr(Nz(SubValue))
Else
' Use Value only.
Key = CStr(Nz(Value))
End If
' Will fail if key isn't present.
Rank(Strategy) = Ranks(Strategy).Item(Key)
End If
RowRank = Rank(Strategy)
Exit_RowRank:
Exit Function
Err_RowRank:
Select Case Err
Case CannotAddKey
' Key is present, thus cannot be added again.
Resume Next
Case CannotFindKey
' Key is not present, thus cannot be removed.
Resume Next
Case Else
' Some other error. Ignore.
Resume Exit_RowRank
End Select
End Function
My purpose is to split a task into constituent tasks and find the most important one.The macro is written in "May" sheet of workallotment.xlsm and the tasks are in tasks.xlsx
For example:
Constituents Constituents Important Imp
Praveen T1 T2 T3 T4 T5 T6 T1+T2+T3 =T5 T3+T5+T6 =T9 T1 T6
4 3 1 2 8 9
Karthik P1 P2 P3 P4 " among T1,T2,T3- T1 takes more time".its imp
6 3 2 2
Walter c1 c2 c3 c4
1 2 3 4
Arvind g1 g2 g3
2 1 3
Sreelatha h1 h2 h3
2 1 1
Code:
Sub workallotment()
Dim workallotmentWB, tasksWB As Workbook
Dim waSheet As Worksheet
Dim str(9) As String
Dim splitArray() As String, S(10) As String
Dim col_new As Integer
Dim wa_nameRng As Range
Dim r As Integer, max As Integer, imps As String
Dim wa_nameRow, wa_firstRow, wa_lastRow As Integer 'work allotment rows
Dim t_firstRow, t_lastrow As Integer 'task rows
Dim curTaskCol As Integer 'current task column
Dim wa_tmpcol As Integer 'work allotment, temp column
Set workallotmentWB = ThisWorkbook
Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
'notes on data structure:
'- tasks workbook:
'first name starts in A1 of "Sheet1"
'- workallotment workbook:
'first name starts in A2 of Sheet named "workallotment"
'tasks are to be written starting in B2
'in Row 1 are headers (number of days)
t_firstRow = 1
wa_firstRow = 2
wa_nameRow = 0
Set waSheet = workallotmentWB.Worksheets("May") ' in this file - workallotment.xlsm
With tasksWB.Worksheets("May") ' in tasks.xlsx which is attached
'finding the last rows
t_lastrow = .Range("A1000000").End(xlUp).row + 1
wa_lastRow = waSheet.Range("A1000000").End(xlUp).row
'goes through all the names in tasks_Sheet1
For r = t_firstRow To t_lastrow Step 2
Set wa_nameRng = waSheet.Range("A:A").find(.Range("A" & r).Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not wa_nameRng Is Nothing Then
wa_nameRow = wa_nameRng.row
curTaskCol = 2
wa_tmpcol = 2
Do While Not IsEmpty(.Cells(r, curTaskCol).Value)
For C = 1 To .Cells(r + 1, curTaskCol).Value
waSheet.Cells(wa_nameRow, wa_tmpcol).Value = .Cells(r, curTaskCol).Value
wa_tmpcol = wa_tmpcol + 1
Next C
curTaskCol = curTaskCol + 1
Loop
End If
Next r
End With
MsgBox ("done")
For r = t_firstRow To t_lastrow Step 2 ' loop to find importance
col = 2 'setting to initial col
curTaskCol = 17 ' position input - constituent jobs at 17th col in tasks.xls
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, curTaskCol).Value)
str(curTaskCol - 16) = tasksWB.Worksheets("May").Cells(r, curTaskCol).Value
' reading input to first array of string element
substr = Left(str(curTaskCol - 16), Application.WorksheetFunction.find("=", str(curTaskCol - 16)) - 1) ' if T1+T2=T3 it'll look before "=" symbol
MsgBox (substr)
splitArray() = Split(substr, "+") ' if T1+T2 it will be split as T1 & T2
For i = LBound(splitArray) To UBound(splitArray)
S(i + 1) = splitArray(i) ' assigning split elements to string array
Next i
For i = LBound(splitArray) To UBound(splitArray)
col_new = 2 ' checking from 2nd column
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, col_new).Value)
If (S(i + 1) = tasksWB.Worksheets("May").Cells(r, col_new).Value) Then 'initialising max and imps
imps = S(i + 1) ' most important job
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
End If ' maximum time taken for task
col_new = col_new + 1
Loop
For j = LBound(splitArray) To UBound(splitArray)
col_new = findcol(S(j + 1), r, tasksWB)
If (max < tasksWB.Worksheets("May").Cells(r + 1, col_new).Value) Then
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
imps = tasksWB.Worksheets("May").Cells(r, col_new).Value
End If
Next j
Next i
tasksWB.Worksheets("May").Cells(r, curTaskCol + 6).Value = imps
' assign most IMPORTANT task on 6th column from current column
curTaskCol = curTaskCol + 1 ' RUNTIME ERROR 1004
Loop
Next r
End Sub
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer, addr As Integer
col = 2 ' checking from column 2
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
addr = col ' if task string is found in column
End If
col = col + 1 ' return column found
Loop
findcol = addr
End Function
Krishnan,
In your main proc workallotment you declare the variable tasksWB.
In your method 'findcol' you then reference tasksWB. It looks like you've pulled this code out of the main proc. The tasksWB only has scope within workallot and so you need to give findcol this object so it will have it within it's scope as well.
I would recommend that you pass the tasksWB into the method, as a third parameter.
Your method would then look as follows.
Edit for your comment of why findcol doesn't return. The Exit Function will ensure that the method is exited immediately after setting the return value. Without this you would end up in the asking for the correct task name again.
Public Function findcol(S As String, row As Integer, theWB as Workbook) As Integer
col = 2 ' checking from column 2
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (S = theWB.Worksheets("May").Cells(row, col).Value) Then
findcol = col ' if task string is found in column
Exit Function
End If
'MsgBox ("Enter correct task names") Not sure why this is here.
col = col + 1 ' return column found
Loop
End Function
and you'd call it with
col_new = findcol(S(j + 1), r, tasksWB) ' ERROR line function to find column of task string
This will ensure that you do not "leak" your variable definition into global scope, and that you also ensure that your method doesn't depend on external globals.
Edit 3:
Your findcol is still wrong.
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer
'******* you don't need this because you can exit early
'Dim addr As Integer
col = 2 ' checking from column 2
'***** THIS LINE NEEDS TO BE REMOVED because you are using theWB being passed in *****
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
'****** this line must use theWB
'If (StrComp(Trim(S), Trim(tasksWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
'************* you can exit early once you've found what you need.
'addr = col ' if task string is found in column
findcol = col
exit function
End If
col = col + 1 ' return column found
Loop
' You can exit early so don't need this.
' findcol = addr
End Function
You should probably do a check when you call the function that the value hasn't returned 0, eg
new_col = findcol( .... )
if new_col = 0 then
msgbox "couldn't find the column with that str" & S(j + 1)
end if
tasksWB isn't recognized in the findcol function as it is declared as Private (=Dim) in the main process.
Declare it at the top of your module, and it'll work! ;)
I want to populate a table with data from a staging table. The interesting column in the staging table has the datatype text but is otherwise filled with either values that are parsable as doubles or are the empty string (ie "4.209", "42" or ""). The according column in the destination table has the data type double.
The SQL Statement I am executing is
insert into dest (.., theColumn, ... ) select ...., theColumn, .. from src
When I execute the statement (using ADO) I receive a Data type mismatch in criteria expression error).
If I replace theColumn with null, it works without error. So, I figure I should somehow convert empty strings to nulls. Is this possible?
Use an IIf() expression: if theColumn contains a string which represents a valid number, return that number; otherwise return Null.
SELECT IIf(IsNumeric(theColumn), Val(theColumn), Null) FROM src
My first impulse was to use IsNumeric(). However I realized this is a more direct translation of what you requested ...
SELECT IIf(theColumn='', Null, Val(theColumn)) FROM src
Convert empty strings to zero maybe also work.
insert into dest (.., theColumn, ... ) select ...., theColumn+0, .. from src
You can use Val to convert "" to 0:
insert into dest (.., theColumn, ... ) select ...., Val(theColumn), .. from src
To insert Null, use a function like this:
' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
' SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
' SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
' SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
' SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
ByVal Value As Variant) _
As String
Const vbLongLong As Integer = 20
Const SqlNull As String = " Null"
Dim Sql As String
Dim LongLong As Integer
#If Win32 Then
LongLong = vbLongLong
#End If
#If Win64 Then
LongLong = VBA.vbLongLong
#End If
Select Case VarType(Value)
Case vbEmpty ' 0 Empty (uninitialized).
Sql = SqlNull
Case vbNull ' 1 Null (no valid data).
Sql = SqlNull
Case vbInteger ' 2 Integer.
Sql = Str(Value)
Case vbLong ' 3 Long integer.
Sql = Str(Value)
Case vbSingle ' 4 Single-precision floating-point number.
Sql = Str(Value)
Case vbDouble ' 5 Double-precision floating-point number.
Sql = Str(Value)
Case vbCurrency ' 6 Currency.
Sql = Str(Value)
Case vbDate ' 7 Date.
Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
Case vbString ' 8 String.
Sql = Replace(Trim(Value), "'", "''")
If Sql = "" Then
Sql = SqlNull
Else
Sql = " '" & Sql & "'"
End If
Case vbObject ' 9 Object.
Sql = SqlNull
Case vbError ' 10 Error.
Sql = SqlNull
Case vbBoolean ' 11 Boolean.
Sql = Str(Abs(Value))
Case vbVariant ' 12 Variant (used only with arrays of variants).
Sql = SqlNull
Case vbDataObject ' 13 A data access object.
Sql = SqlNull
Case vbDecimal ' 14 Decimal.
Sql = Str(Value)
Case vbByte ' 17 Byte.
Sql = Str(Value)
Case LongLong ' 20 LongLong integer (Valid on 64-bit platforms only).
Sql = Str(Value)
Case vbUserDefinedType ' 36 Variants that contain user-defined types.
Sql = SqlNull
Case vbArray ' 8192 Array.
Sql = SqlNull
Case Else ' Should not happen.
Sql = SqlNull
End Select
CSql = Sql & " "
End Function
I am importing sql into my Access database and am working on parsing the data into the correct tables and fields. Again I turn to you gurus to assist in a problem
One of the fields that is imported has comma separated values that need to be separated.there are anywhere from one to 10 possible values in the string.
PHO,Rosgen,NRCS,EMAP,T-DL,YSI-DL
I have figured out that if I make all of the values the same length (say 4 characters) I can get the 1st, last and 1st after the comma to parse but cannot seem to get the middle values extracted correctly.
SELECT Left([FieldForms],InStr([FieldForms],",")-1) AS DEQ_SampleTypeID
FROM tblSiteVisit
UNION ALL
SELECT Mid([FieldForms],InStr([FieldForms],",")+1,4) AS DEQ_SampleTypeID
FROM tblSiteVisit
UNION ALL
SELECT Mid([FieldForms], 11, 4) AS DEQ_SampleTypeID
FROM tblSiteVisit
UNION ALL
SELECT Mid([FieldForms], 16, 4) AS DEQ_SampleTypeID
FROM tblSiteVisit
UNION ALL
SELECT Mid([FieldForms], 21, 4) AS DEQ_SampleTypeID
FROM tblSiteVisit
UNION ALL
SELECT Mid([FieldForms],InStrRev([FieldForms],",")-4,4) AS DEQ_SampleTypeID
FROM tblSiteVisit
UNION ALL
SELECT Right([FieldForms],InStr([FieldForms],",")-1) AS DEQ_SampleTypeID
FROM tblSiteVisit
If I use the InStrRev or the Right Function I get repeats if there are fewer than the maximum also using the Mid functions results in empty rows.
Is there a way to parse out a string like this and only get results from the string
Put the following functions into a Module:
Function CountCSWords (ByVal S) As Integer
' Counts the words in a string that are separated by commas.
Dim WC As Integer, Pos As Integer
If VarType(S) <> 8 Or Len(S) = 0 Then
CountCSWords = 0
Exit Function
End If
WC = 1
Pos = InStr(S, ",")
Do While Pos > 0
WC = WC + 1
Pos = InStr(Pos + 1, S, ",")
Loop
CountCSWords = WC
End Function
Function GetCSWord (ByVal S, Indx As Integer)
' Returns the nth word in a specific field.
Dim WC As Integer, Count As Integer, SPos As Integer, EPos As Integer
WC = CountCSWords(S)
If Indx < 1 Or Indx > WC Then
GetCSWord = Null
Exit Function
End If
Count = 1
SPos = 1
For Count = 2 To Indx
SPos = InStr(SPos, S, ",") + 1
Next Count
EPos = InStr(SPos, S, ",") - 1
If EPos <= 0 Then EPos = Len(S)
GetCSWord = Trim(Mid(S, SPos, EPos - SPos + 1))
End Function
Then, put a field in your query like this:
MyFirstField: GetCSWord([FieldForms],1)
Put another one in like this:
MySecondField: GetCSWord([FieldForms],2)
Etc... for as many as you need.
This VBA code reads text values from FieldForms in tblSiteVisit, splits that text into substrings, and then stores each of the substrings in DEQ_SampleTypeID in a new row added to tblDestination.
Dim astrItems() As String
Dim db As DAO.database
Dim i As Long
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strInsert As String
strInsert = "INSERT INTO tblDestination (DEQ_SampleTypeID)" & vbCrLf & _
"VALUES ([array_item]);"
Set db = CurrentDb
Set rs = db.OpenRecordset("tblSiteVisit", dbOpenTable, dbOpenSnapshot)
Set qdf = db.CreateQueryDef(vbNullString, strInsert)
Do While Not rs.EOF
astrItems = Split(rs!FieldForms, ",")
For i = 0 To UBound(astrItems)
qdf.Parameters("array_item") = astrItems(i)
qdf.Execute dbFailOnError
Next
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set qdf = Nothing
Set db = Nothing
So, I've looked all over the web for this simple answer...and I can't find it.
I am trying to search an access DB via coldfusion query.
<cfquery name = "x" datasource = "cassupport_computers">
SELECT last, first, dept, location, purchasedate, (last + ' ' + first + ' ' + dept + ' ' + location + ' ' + purchasedate AS searchs)
FROM cas_computers
WHERE searchs like '%#form.searchfield#%'
</cfquery>
What am I doing wrong? x:
<cfquery name = "x" datasource = "cassupport_computers">
SELECT last, first, dept, location, purchasedate, last & ' ' & first & ' ' & dept & ' ' & location & ' ' & purchasedate AS searchs
FROM cas_computers
WHERE searchs like '%#form.searchfield#%'
</cfquery>