Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2014-10-05
29
Medium Priority
?
208 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 16
  • 9
  • 4
29 Comments
 
LVL 12

Accepted Solution

by:
James Elliott earned 1000 total points
ID: 40361997
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
ID: 40362001
I am access..sorry i didnt make that clear.
0
 

Author Comment

by:PeterBaileyUk
ID: 40362004
*in
0
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 
LVL 12

Expert Comment

by:James Elliott
ID: 40362011
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
ID: 40362016
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
ID: 40362023
of course AliasArray needs to be arrTMP in your version of the code
0
 

Author Comment

by:PeterBaileyUk
ID: 40362025
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
ID: 40362026
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
ID: 40362033
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
ID: 40362034
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
ID: 40362036
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
ID: 40362041
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
ID: 40362045
Delete line 13
0
 
LVL 7

Expert Comment

by:Gauthier
ID: 40362046
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
 
LVL 7

Expert Comment

by:Gauthier
ID: 40362057
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
ID: 40362059
I've seen the problem. Working through it now. 10 mins.
0
 
LVL 12

Expert Comment

by:James Elliott
ID: 40362064
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
ID: 40362067
^^ please note correction to line 34 if you tried this before I corrected
0
 
LVL 12

Expert Comment

by:James Elliott
ID: 40362070
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
ID: 40362075
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
ID: 40362082
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 1000 total points
ID: 40362197
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
ID: 40362201
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
ID: 40362217
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
ID: 40362222
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
ID: 40362460
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
ID: 40363084
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
ID: 40363290
ok i am coming away from scoring and will try filtering instead. have shared the points
0

Featured Post

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

715 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