Solved

count words in string where alias process took place in access vba

Posted on 2014-10-05
29
187 Views
Last Modified: 2014-10-06
Ok I have a piece of code that has split a string taken from a subform row and put into an array called word array.  It then rotates around the array and searches for the word in a table called tblReverseFilter.

it increments a counter. this process works perfectly.

' word counter where words did not have a alias word    
'wordarray contains the string of words split
' the string of words had some words removed so grouping could take place
'reversefilter will show what those oiginal strings where
  '******************************************************
                        index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                            
                            If InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0 Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window


I need to do the same but adjust the counter so that it it correctly scores taking into account alias words

row from subform (this is a string of words in wordarray but have been aliaised)
example
 "Business [Professional Media]" may have had the word "[Prof" which was corrected to "[Professional"

I have an array called arrTMP this contains the data of words that need to be corrected
sClientDescgroup                    sdesc
[Professional                             [Prof
AEGEAN (COMPAC                  AEGEAN(COMPAC


so wordarray
"TI SPORT AEGEAN (COMPAC"

tblreversefilter contains the original string
"318 TI SPORT AEGEAN(COMPAC"

I need to be able to make the count correctly
"ti" from wordarray  is in  original string so add 1 to counter
"sport" from wordarray  is in  original string so add 1 to counter

"AEGEAN (COMPAC" was originally "AEGEAN(COMPAC" (as alias table tells me) so how do i correctly count allowing for alias table entry?

the count should be 3 but if i use original code in this case it would be 4
0
Comment
Question by:PeterBaileyUk
  • 16
  • 9
  • 4
29 Comments
 
LVL 12

Accepted Solution

by:
James Elliott earned 250 total points
Comment Utility
You could add Excel as a reference in your vba project, then use a vlookup on your alias table.

Excel.Worksheetfunction.Vlookup(yourUncorrectedValue, yourAliasArray,2,FALSE)

Open in new window


Then you can simply 'or' this in your count.

 If (InStr(.Fields("StrOriginal").Value, WordArray(Index)) <> 0) Or _
    (InStr(excel.VLookup(.Fields("StrOriginal").Value, AliasArray, 2, False), WordArray(Index)) <> 0) Then
    

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
I am access..sorry i didnt make that clear.
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
*in
0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
You did.

You can go to your VB editor. Click tools => references, and then tick Microsoft Excel Object library. The code should then work.

Rgds
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
ok will have a look, it certainly the method i couldnt figure out ok just adding now
0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
of course AliasArray needs to be arrTMP in your version of the code
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
I got stuck here i added the reference to excel objects. Then substituted the instr.

not sure what to pass to the vlookup, the whole array, if so how?
at the moment ot rotates around the individual words in wordarray


 Dim index2 As Long
                    
                    Dim z As Variant
                    
                    
                      index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                        
                             z = Excel.WorksheetFunction.VLookup(WordArray(index), not sure what to put here, 2, False)
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            (InStr(Excel.VLookup(.Fields("StrOriginal").Value, AliasArray, 2, False), WordArray(index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
it has compile error too method or data member not found on this line:
 (InStr(Excel.VLookup(.Fields("StrOriginal").Value, AliasArray, 2, False), WordArray(index)) <> 0) Then
 Dim index2 As Long
                    
                    Dim z As Variant
                    
                    
                      index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                        
                             z = Excel.WorksheetFunction.VLookup(WordArray(index), not sure what to put here, 2, False)
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            (InStr(Excel.VLookup(.Fields("StrOriginal").Value, AliasArray, 2, False), WordArray(index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
ok .vlookup wont compile still but corrected above to ArrTMP

    index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                        
                    
                        
                             z = Excel.WorksheetFunction.VLookup(WordArray(index), arrTmp, 2, False)
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            (InStr(Excel.VLookup(.Fields("StrOriginal").Value, arrTmp, 2, False), WordArray(index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
do i have to declare an excel object?
    index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                        
                    
                        
                             z = Excel.WorksheetFunction.VLookup(WordArray(index), arrTmp, 2, False)
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            (InStr(Excel.VLookup(.Fields("StrOriginal").Value, arrTmp, 2, False), WordArray(index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window

0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
You're missing 'worksheetfunction' in your if statement.

  index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                        
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            (InStr(Excel.worksheetfunction.VLookup(.Fields("StrOriginal").Value, arrTmp, 2, False), WordArray(index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
it ran but gave error 1004 unable to get the vlookup property of the worksheet function class

  '*********************************************************************************************************
                    'count alias
                    Dim index2 As Long
                    
                    Dim z As Variant
                    
                    
                      index = 0
                      
                        
                    'stopped here error 1004
                        
                             z = Excel.WorksheetFunction.VLookup(WordArray(index), arrTmp, 2, False)
                             
                  
                            
                        For index = LBound(WordArray) To UBound(WordArray)
                        
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            (InStr(Excel.WorksheetFunction.VLookup(.Fields("StrOriginal").Value, arrTmp, 2, False), WordArray(index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                    
                    
                      Next index
                    
                  End If
                    
                    
                    
      
                    

Open in new window

0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
Delete line 13
0
 
LVL 7

Expert Comment

by:Gauthier
Comment Utility
That code looks fishy, I'm not sure I follow you fully, what is in .Fields("StrOriginal").Value ?
are you sure you are prefix safe in your first InStr ?
how do you break the input in words ? (only with " " ?)

I would suggest
                        strReversefilter = " " + Join(tblreversefilter, " ") + " "
                        index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                            strWord = WordArray(index)
                            If InStr(.Fields("StrOriginal").Value, strWord) <> 0 and InStr(strReversefilter, " " + strWord + " ") <> 0 Then
                            
                                WordCounter = WordCounter + ( (inStr(? 1 : 0)
                            Else
                            
                            End If
                        
                        
                        Next index

Open in new window


But I suspect the original is already buggy without the alias problematic.
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 7

Expert Comment

by:Gauthier
Comment Utility
Question:
Was AEGEAN(COMPAC split in two words "AEGEAN" "(COMPAC" or corrected to one word including a space?

How would you want to handle a partial match if  after correction, AEGEAN was present and not (COMPAC ?
0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
I've seen the problem. Working through it now. 10 mins.
0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
Ok, I've now added an error handler.

Sub EE()

                    Dim index2 As Long
                    Dim bFlag As Boolean
                    Dim z As Variant
                    
                    On Error GoTo err_handler
                    
                      Index = 0
                      
                             z = Excel.WorksheetFunction.VLookup(WordArray(Index), arrTmp, 2, False)
                             
                        For Index = LBound(WordArray) To UBound(WordArray)
                        
                             
                             If (InStr(.Fields("StrOriginal").Value, WordArray(Index)) <> 0) Or _
                            (InStr(z, WordArray(Index)) <> 0) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                    
                    
                      Next Index
                    
                  End If
                   
on error goto 0 


    Exit Sub

err_handler:
    If Err.Number = 1004 Then bFlag = True: Err.Clear: Resume Next
    
End Sub

Open in new window

0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
^^ please note correction to line 34 if you tried this before I corrected
0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
Too many errors above, sorry.

Try this one:

Dim index2 As Long
                    Dim bFlag As Boolean
                    Dim z As Variant
                    
       
                    
                      Index = 0

                        For Index = LBound(WordArray) To UBound(WordArray)
                       
             On Error GoTo err_handler

                              z = Excel.WorksheetFunction.VLookup(WordArray(Index), arrTmp, 2, False)

            On error goto 0 

                             If (InStr(.Fields("StrOriginal").Value, WordArray(Index)) <> 0) Or _
                            iif(not bflag,(InStr(z, WordArray(Index)) <> 0),false) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                    
                    
                      Next Index
                    
                  End If
                   



    Exit Sub

err_handler:
    If Err.Number = 1004 Then bFlag = True: Err.Clear: Resume Next
    
End Sub

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
ok ive taken some pics so you see the process

i have car description in a main table, the strings contain technical detail that has been removed and then after that the descriptions group nicely for the trim level of the vehicle models.

You can see this in the frmdecoderesult each column represents the client in this example abi

the modelalias table tells me what words to change where the supplier abbreviated the words in various ways.

what i wanted to do was to bring up the original wordstrings in a floating form after the user had double clicked the row.

so he clicks " TI SPORT AEGEAN (COMPAC"

and a form comes back that shows the original strings

to pull those rows back involves filtering on each word
TI
SPORT
(these two didnt have alias substitution.
aegean as a separate word didnt exist neither did (compac they were corrected for clarity
of course now i need to filter on
"AEGEAN(COMPAC"

to pull any records with that in.

The scoring takes place so that I can remove rows in tblreverse filter that were not relevant so if word array had 4 words then count would equal 4 in non aliased count

in this example as i said the count would be wrong.
eeexample1.PNG
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
I did it this way because i can rotate and filter on one word at a time and the scoring allows me to grab rows where the correct number of words were found. the ones that dont have correct count can be discarded
0
 
LVL 7

Assisted Solution

by:Gauthier
Gauthier earned 250 total points
Comment Utility
So you have car with beautified/decoded descriptions and do not know which one of the substitution was used.
So we'll just undo them

If I follow you in your example:
.Fields("StrOriginal").Value == "318 TI SPORT AEGEAN(COMPAC"

You split that in words "318", "TI", "SPORT", "AEGEAN(COMPAC"
you beautify it and remove irrelevant words with the alias table.
it gives you this array "TI", "SPORT", "AEGEAN (COMPAC" which you do not store
and you store "TI SPORT AEGEAN (COMPAC"
However your search and match must be done on the non beautified words.
Looks to me like you need to first undo the beautification with a simple reverse replace.
Note that if for example you have collision like both "pro", "prof", "pro." all expanded to professional, reversing that is not possible! and you'll have to revise your approach.
 
it's rather simple but can you tell me how you set/populate the arrTMP "array" variable? VBA doesn't have that kind of Array... I'll assume an array of objects using this syntax for now:

Dim obj as Variant
Dim strFilter = " " + JOIN(WordArry, " ") + " "
For index=LBound(arrTMP) to UBound(arrTMP)
  obj = arrTMP(index)
  strFilter = Replace(strFilter, " "+ obj.sClientDescgroup + " ", " " + obj.sdesc + " ")
Next index
arrFilter = Split(Trim(strFilter))
For index = LBound(arrFilter) To UBound(arrFilter)			
  If InStr(.Fields("StrOriginal").Value, arrFilter(index)) <> 0 Then	
    WordCounter = WordCounter + 1
  End If	
Next index

Open in new window

0
 

Author Comment

by:PeterBaileyUk
Comment Utility
I may have added the code wrong as its not scoring, however it doesn't crash with error that's good also.

so you can see the issue clearly because I didn't explain it well i have attached a spreadsheet of the rows

its easier to see what I am trying to achieve
example.xlsx
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
I will post the routine whole. I was just experimenting with a query to see if it was easier that way BUT you have understood it perfectly.

heres the routine in full its not that big where it uses the getrows method is where it gets the alias detail.

Public Sub ReverseFilters(Strin As String, strName As String)

Dim Db As DAO.Database
Set Db = CurrentDb()
Dim WordArray() As String
Dim AliasArray() As String
Dim arrTmp() As Variant
Dim StrClientName As String
Dim StrModelName As String
Dim ClientLength As Long
Dim FrontLength As Long
Dim EndLength As Long
Dim StrTemp As String
Dim counter As Long
Dim StrSelect As String
Dim StrFrom As String
Dim StrGroup As String
Dim StrHaving As String

Dim StrAliasSelect As String
Dim StrAliasFrom As String
Dim StrAliasWhere As String
Dim SQLAlias As String
Dim WordCount As Long
Dim WordCounter As Long
Dim SQL As String


Dim BAlias As Boolean

Dim BisRange As Boolean
Dim RstRange As DAO.Recordset
Dim RstAlias As DAO.Recordset
Dim RstReverse As DAO.Recordset

Dim x As Long
Dim index As Long
Dim indexArrTmp As Long
index = 0
Dim strCriteria As String
FrontLength = 3
EndLength = 9
DoCmd.SetWarnings False
DoCmd.RunSQL ("delete * from tblReversefilter")
WordArray() = Split(Trim(Strin))
SQLAlias = ""
SQL = ""
WordCount = UBound(WordArray) + 1


'StrTemp = Me.Name

StrTemp = strName
ClientLength = Len(StrTemp) - (FrontLength + EndLength)
'get client name
StrClientName = Mid(StrTemp, FrontLength + 1, ClientLength)

'get model name
StrModelName = ModelStore
'work out if singular model or range of vehicle
Set RstRange = Db.OpenRecordset("SELECT TblProcess.Process FROM TblProcess GROUP BY TblProcess.Process;")

strCriteria = "[Process] = '" & StrModelName & "'"

With RstRange
    .FindFirst strCriteria
    If RstRange.NoMatch Then
        BisRange = False
    Else
        BisRange = True
    End If

End With
'we will filter through this recordset and change the having part of the sql

StrSelect = "INSERT INTO TblReverseFilter ( StrOriginal ) SELECT ClientWordGroups.OriginalString"
StrFrom = " From ClientWordGroups"
StrGroup = " GROUP BY ClientWordGroups.OriginalString, ClientWordGroups.Groups, ClientWordGroups.Client"








'create alias table detail taking into account client and model


StrAliasSelect = "SELECT TblModelAlias.sDesc, TblModelAlias.sClient, TblModelAlias.sModel, TblModelAlias.sClientDescGroup, InStr('" & Strin & "',[sClientDescGroup])<>0 AS Expr1"
StrAliasFrom = " FROM TblModelAlias"
StrAliasWhere = " WHERE (((TblModelAlias.sClient)='" & StrClientName & "') AND ((TblModelAlias.sModel)='" & StrModelName & "' AND ((InStr('" & Strin & "',[sClientDescGroup])<>0)=True)));"

SQLAlias = StrAliasSelect & StrAliasFrom & StrAliasWhere
Debug.Print "sqlalias: " & SQLAlias
Set RstAlias = Db.OpenRecordset(SQLAlias)

'check if words in string appear in alias table if they do store them
Dim y As Long

Dim intRowNum As Integer
Dim intColNum As Integer
    With RstAlias

        If RstAlias.BOF And RstAlias.EOF Then
        Else
        .MoveLast
        y = .RecordCount
        .MoveFirst
        'cycle through the recordset
          'append rows to array
          
            arrTmp = .GetRows(y)
          
     End If
    End With
        
' create sql
If BisRange = True Then
'alias true too here
    Dim fldindex
    
    index = 0
   'create rows based on filter words and append to table
    'now get alias words as we use these to filter and rotate
    For index = LBound(arrTmp, 2) To UBound(arrTmp, 2)

        
            StrHaving = " HAVING (((ClientWordGroups.Groups)='" & StrModelName & "') AND ((ClientWordGroups.Client)='" & StrClientName & "' AND ((ClientWordGroups.originalstring) Like '*" & arrTmp(0, index) & "*')));"
            SQL = StrSelect & StrFrom & StrGroup & StrHaving
            DoCmd.SetWarnings False
            
            DoCmd.RunSQL (SQL)
            Debug.Print SQL
       
        
    Next index
    
    
 
    
Else
'no range no alias


    index = 0
    For index = LBound(WordArray) To UBound(WordArray)
    
    'create rows based on filter words and append to table
        StrHaving = " HAVING (((ClientWordGroups.Groups) Is Null) AND ((ClientWordGroups.Client)='" & StrClientName & "' AND ((ClientWordGroups.originalstring) Like '*" & WordArray(index) & "*')));"
        SQL = StrSelect & StrFrom & StrGroup & StrHaving
        DoCmd.SetWarnings False
        Debug.Print SQL
        DoCmd.RunSQL (SQL)
       
 
    Next index



End If


'now some method to score


Set RstReverse = Db.OpenRecordset("TblReverseFilter")

WordCounter = 0
With RstReverse
    If RstReverse.BOF And RstReverse.EOF Then
        Else
                .MoveFirst
                'cycle through the recordset
                Do Until RstReverse.EOF
                
                    If BisRange = False Then
                
                    '******************************************************
                        index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                            'check words in word array against words in tblreversefilter
                            If InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0 Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            
                            
                            End If
                        
                        
                        Next index
                        
                        
                       ' all part above works fine
                    Else
                    
                    '*********************************************************************************************************
                    'count alias
               
                   Dim index2 As Long
                    Dim bFlag As Boolean
                    Dim z As Variant
                    
       
                    
                      index = 0

                        For index = LBound(WordArray) To UBound(WordArray)
                       
             On Error GoTo err_handler

                              z = Excel.WorksheetFunction.VLookup(WordArray(index), arrTmp, 2, False)

            On Error GoTo 0

                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            IIf(Not bFlag, (InStr(z, WordArray(index)) <> 0), False) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                    
                    
                      Next index
                    
                  End If
                  
                  Exit Sub
            
                  
      
                   
                    '*****************************************************
                    
                    
                .Edit
                
                .Fields("LngScore").Value = WordCounter
                .Update
                WordCounter = 0
                .MoveNext
                Loop
        
    End If

End With
DoCmd.SetWarnings True

err_handler:
    If Err.Number = 1004 Then bFlag = True: Err.Clear: Resume Next

End Sub

Open in new window


ok I just tried this maybe this is a better way

SELECT TblReverseFilter.StrOriginal, InStr([stroriginal],[sdesc]) AS Expr1, InStr([stroriginal],[sClientdescgroup]) AS Expr2 INTO TblReverseFiltTemp
FROM TblReverseFilter, TblModelAlias
GROUP BY TblReverseFilter.StrOriginal, InStr([stroriginal],[sdesc]), InStr([stroriginal],[sClientdescgroup])
HAVING (((InStr([stroriginal],[sdesc]))<>0) AND ((InStr([stroriginal],[sClientdescgroup]))<>0));

Open in new window


maybe itll be easier now to just group the answer of the sql.
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
it didnt quite work the query way as the rows need to contain variants of all 3 filter words
Public Sub ReverseFilters(Strin As String, strName As String)

Dim Db As DAO.Database
Set Db = CurrentDb()
Dim WordArray() As String
Dim AliasArray() As String
Dim arrTmp() As Variant
Dim StrClientName As String
Dim StrModelName As String
Dim ClientLength As Long
Dim FrontLength As Long
Dim EndLength As Long
Dim StrTemp As String
Dim counter As Long
Dim StrSelect As String
Dim StrFrom As String
Dim StrGroup As String
Dim StrHaving As String

Dim StrAliasSelect As String
Dim StrAliasFrom As String
Dim StrAliasWhere As String
Dim SQLAlias As String
Dim WordCount As Long
Dim WordCounter As Long
Dim SQL As String


Dim BAlias As Boolean

Dim BisRange As Boolean
Dim RstRange As DAO.Recordset
Dim RstAlias As DAO.Recordset
Dim RstReverse As DAO.Recordset

Dim x As Long
Dim index As Long
Dim indexArrTmp As Long
index = 0
Dim strCriteria As String
FrontLength = 3
EndLength = 9
DoCmd.SetWarnings False
DoCmd.RunSQL ("delete * from tblReversefilter")
WordArray() = Split(Trim(Strin))
SQLAlias = ""
SQL = ""
WordCount = UBound(WordArray) + 1


'StrTemp = Me.Name

StrTemp = strName
ClientLength = Len(StrTemp) - (FrontLength + EndLength)
'get client name
StrClientName = Mid(StrTemp, FrontLength + 1, ClientLength)

'get model name
StrModelName = ModelStore
'work out if singular model or range of vehicle
Set RstRange = Db.OpenRecordset("SELECT TblProcess.Process FROM TblProcess GROUP BY TblProcess.Process;")

strCriteria = "[Process] = '" & StrModelName & "'"

With RstRange
    .FindFirst strCriteria
    If RstRange.NoMatch Then
        BisRange = False
    Else
        BisRange = True
    End If

End With
'we will filter through this recordset and change the having part of the sql

StrSelect = "INSERT INTO TblReverseFilter ( StrOriginal ) SELECT ClientWordGroups.OriginalString"
StrFrom = " From ClientWordGroups"
StrGroup = " GROUP BY ClientWordGroups.OriginalString, ClientWordGroups.Groups, ClientWordGroups.Client"








'create alias table detail taking into account client and model


StrAliasSelect = "SELECT TblModelAlias.sDesc, TblModelAlias.sClient, TblModelAlias.sModel, TblModelAlias.sClientDescGroup, InStr('" & Strin & "',[sClientDescGroup])<>0 AS Expr1"
StrAliasFrom = " FROM TblModelAlias"
StrAliasWhere = " WHERE (((TblModelAlias.sClient)='" & StrClientName & "') AND ((TblModelAlias.sModel)='" & StrModelName & "' AND ((InStr('" & Strin & "',[sClientDescGroup])<>0)=True)));"

SQLAlias = StrAliasSelect & StrAliasFrom & StrAliasWhere
Debug.Print "sqlalias: " & SQLAlias
Set RstAlias = Db.OpenRecordset(SQLAlias)

'check if words in string appear in alias table if they do store them
Dim y As Long

Dim intRowNum As Integer
Dim intColNum As Integer
    With RstAlias

        If RstAlias.BOF And RstAlias.EOF Then
        Else
        .MoveLast
        y = .RecordCount
        .MoveFirst
        'cycle through the recordset
          'append rows to array
          
            arrTmp = .GetRows(y)
          
     End If
    End With
        
' create sql
If BisRange = True Then
'alias true too here
    Dim fldindex
    
    index = 0
   'create rows based on filter words and append to table
    'now get alias words as we use these to filter and rotate
    For index = LBound(arrTmp, 2) To UBound(arrTmp, 2)

        
            StrHaving = " HAVING (((ClientWordGroups.Groups)='" & StrModelName & "') AND ((ClientWordGroups.Client)='" & StrClientName & "' AND ((ClientWordGroups.originalstring) Like '*" & arrTmp(0, index) & "*')));"
            SQL = StrSelect & StrFrom & StrGroup & StrHaving
            DoCmd.SetWarnings False
            
            DoCmd.RunSQL (SQL)
            Debug.Print SQL
       
        
    Next index
    
    
 
    
Else
'no range no alias


    index = 0
    For index = LBound(WordArray) To UBound(WordArray)
    
    'create rows based on filter words and append to table
        StrHaving = " HAVING (((ClientWordGroups.Groups) Is Null) AND ((ClientWordGroups.Client)='" & StrClientName & "' AND ((ClientWordGroups.originalstring) Like '*" & WordArray(index) & "*')));"
        SQL = StrSelect & StrFrom & StrGroup & StrHaving
        DoCmd.SetWarnings False
        Debug.Print SQL
        DoCmd.RunSQL (SQL)
       
 
    Next index



End If


'now some method to score


Set RstReverse = Db.OpenRecordset("TblReverseFilter")

WordCounter = 0
With RstReverse
    If RstReverse.BOF And RstReverse.EOF Then
        Else
                .MoveFirst
                'cycle through the recordset
                Do Until RstReverse.EOF
                
                    If BisRange = False Then
                
                    '******************************************************
                        index = 0
                        For index = LBound(WordArray) To UBound(WordArray)
                            'check words in word array against words in tblreversefilter
                            If InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0 Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            
                            
                            End If
                        
                        
                        Next index
                        
                        
                       ' all part above works fine
                    Else
                    
                    '*********************************************************************************************************
                    'count alias
               
                   Dim index2 As Long
                    Dim bFlag As Boolean
                    Dim z As Variant
                    
       
                    
                      index = 0

                        For index = LBound(WordArray) To UBound(WordArray)
                       
             On Error GoTo err_handler

                              z = Excel.WorksheetFunction.VLookup(WordArray(index), arrTmp, 2, False)

            On Error GoTo 0

                             If (InStr(.Fields("StrOriginal").Value, WordArray(index)) <> 0) Or _
                            IIf(Not bFlag, (InStr(z, WordArray(index)) <> 0), False) Then
                            
                                WordCounter = WordCounter + 1
                            Else
                            
                            End If
                    
                    
                      Next index
                    
                  End If
                  
                  Exit Sub
            
                  
      
                   
                    '*****************************************************
                    
                    
                .Edit
                
                .Fields("LngScore").Value = WordCounter
                .Update
                WordCounter = 0
                .MoveNext
                Loop
        
    End If

End With
DoCmd.SetWarnings True

err_handler:
    If Err.Number = 1004 Then bFlag = True: Err.Clear: Resume Next

End Sub

Open in new window

SELECT TblReverseFilter.StrOriginal, InStr([stroriginal],[sdesc]) AS Expr1, InStr([stroriginal],[sClientdescgroup]) AS Expr2 INTO TblReverseFiltTemp
FROM TblReverseFilter, TblModelAlias
GROUP BY TblReverseFilter.StrOriginal, InStr([stroriginal],[sdesc]), InStr([stroriginal],[sClientdescgroup])
HAVING (((InStr([stroriginal],[sdesc]))<>0) AND ((InStr([stroriginal],[sClientdescgroup]))<>0));

Open in new window

exwords.PNG
0
 
LVL 7

Expert Comment

by:Gauthier
Comment Utility
So you do have multiple alias, expending to the same clear text (ouch!). Then my solution will not work.

Neither will yours! (score counter exploding with Pro, Prof, [Prof all matching [Prof Media] !!!)

Why not expand all the string original first and store them in the table?
I would suggest further cleaning by removing replacing ][)( with spaces
strOriginal, strExpanded, lngScore.

Then you only need to match against the known expanded terms...
0
 

Author Comment

by:PeterBaileyUk
Comment Utility
getting the "unexpanded" words, has already been done, so I append those strings to my tblreversefilter.

If i could create a filter like unexpandedword and like unexpandedword and so on then it would theoretically work.

from the alias table I know the unexpanded words but it also tells me in an abstract way the number of possible filter elements .. I the case below the filter will have three.
[Business
Media]
[Professional

so armed with that can i create the filter phrase i can reduce the words to filter by going to the word with least length so prof and pro i would choose pro

Ive put the idea in the spreadsheet.


sClientDescGroup
[Business
[Professional
Media]
Media]
Media]
[Professional
[Business
[Professional
Business
Business
[Professional
[Professional
[Professional
filterexample.xlsx
0
 

Author Closing Comment

by:PeterBaileyUk
Comment Utility
ok i am coming away from scoring and will try filtering instead. have shared the points
0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now