[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 294
  • Last Modified:

Trygve: followup 10206997 need additional help

Routine is as follows:
Call routine from command button.
                 Private Sub Command0_Click()
                 batchShort "master", "mod1"
                 End Sub
               
To Table called "Master" Field, "mod1"  <---- Arguments
               
                From a table called tblBatchReplace.
                 fields are
                 replacetext    withtext
                > 
 In the replacetext field I sometimes have a record that may contain more than one word.
               
                > replacetext                   withtext
                > INTEGRATED SAW          INTGRTD SAW
                > KARTRIDGE                   KRTRDG
                > KARTRIDGE PAK             KRTRDG PAK
               

Everyting is working fine,

THIS IS WHAT I NEED:

I need the routine to start after the first comma in the field.
Example
KARTRIDGE PAK, KARTRIDGE PAK

SHOULD READ:
KARTRIDGE PAK, KRTRDG PAK

Anything before the first comma doesn't get looked at!!


Public Function getshort(ByVal strLong As String, strtable As String, p As Page) As String
Dim rst As Recordset


Set rst = CurrentDb.OpenRecordset(strtable, dbOpenSnapshot)

rst.FindFirst "replacetext= '" & strLong & "' AND strTab='" & p.Parent.ControlName & "'  AND strpage='" & p.Name & "'"
If Not rst.NoMatch Then
 getshort = rst!WithText
Else
 getshort = strLong
End If
End Function

Private Function NewChangeIt(strtemp As String) As String
'********************************************************************************
'PURPOSE:  Parse the passed string and replace any word found in look up table
'IN:       String to parse
'OUT:      Altered string
'********************************************************************************

Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblBatchReplace ORDER BY Priority, ReplaceText", dbOpenSnapshot)

If rst.EOF Then
    NewChangeIt = strtemp '
    GoTo ExitMe
End If

Do Until rst.EOF
    Do Until InStr(strtemp, rst!ReplaceText) = 0
        strtemp = Left(strtemp, InStr(strtemp, rst!ReplaceText) - 1) & rst!WithText & Mid(strtemp, InStr(strtemp, rst!ReplaceText) + Len(rst!ReplaceText))
    Loop
    rst.MoveNext
Loop

NewChangeIt = strtemp


ExitMe:
    rst.Close
    Set rst = Nothing
   
    Exit Function

End Function

Private Function checkshort(strpassed As String) 'As String
'********************************************************************************
'PURPOSE:  Look for a 'short' version of the passed word
'IN:       word to look up
'OUT:      Short word if found, otherwise unchanged word
'DATE:     12 July 1999
'********************************************************************************


Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("tblBatchReplace", dbOpenSnapshot)

rst.FindFirst "replacetext='" & strpassed & "'"

If Not rst.NoMatch Then
checkshort = rst!WithText
Else
checkshort = strpassed
End If


rst.Close
Set rst = Nothing

End Function

Public Function batchShort(strSourcetablename As String, strFieldname As String)
          '********************************************************************************
          'PURPOSE:   Replace any word in the given field in the given table with a 'short'
          '           version from tblBatchreplace if it is there
          'Solution: Using a slightly different approach. I pull up the set of replacement alternatives
          '             and then loop through them seing if any of them fit.
          '             Note that the Priority field in tblBatchReplace can be used to give priority to some
          '             replacement alternavis. The rest is sorted by alphabeth
          'IN:        Table name. Field name to search
          'OUT:       Nothing yet
          '********************************************************************************
          Dim strtemp As String  'variable to hold the 'old' value
          Dim rst As Recordset
          Dim strsql As String
           
          strsql = "select " & strFieldname & " from " & strSourcetablename
          Set rst = CurrentDb.OpenRecordset(strsql, dbOpenDynaset)
          If rst.EOF Then Exit Function
          rst.MoveLast
          rst.MoveFirst
           
          Call SysCmd(acSysCmdInitMeter, "Working", rst.RecordCount)

          With rst
              Do While Not .EOF
                  Call SysCmd(acSysCmdUpdateMeter, rst.AbsolutePosition)
               
                  strtemp = Nz(rst.Fields(strFieldname))
                  .Edit
                      .Fields(strFieldname) = Trim(NewChangeIt(strtemp))
                  .Update
                  .MoveNext
              Loop
          End With
          SysCmd (acSysCmdClearStatus)
                       
      End Function

help appreciated
Hope you are doing well.
fordraiders

0
Fordraiders
Asked:
Fordraiders
  • 6
  • 4
1 Solution
 
JimMorganCommented:
fordraiders:

Why don't you use DLookup to find the replacement text value?

   First lookup the entire field value and if it is found, then job done.

   If not found, then lookup each word in the field value for a replacement.

If this is what you were wanting, then I would proceed like this.

Make a slight change in getting the field value to make the work time a little shorter.  There is no need to check a field if it is Null and no need to replace the value if it has not changed.

   Dim strOut as String
   Dim strIn as String
   strOut = Nz(rst.Fields(strFieldname), vbNullString)
   If Len(strOut) Then
      strIn = NewChangeIt(strOut)
      If strIn <> strOut Then
         .Edit
         .Fields(strFieldname) = Trim(strIn)
         .Update
      End If
   End If

I don't know how big a value would be in a field.  I'm making an assumption that you want to change short phrases to a shorted phrase.  If so, I'd change NewChangeIt like this:

Private Function NewChangeIt(strtemp As String) As String
'********************************************************************************
'PURPOSE:  Parse the passed string and replace any word found in look up table
'IN:       String to parse
'OUT:      Altered string
'********************************************************************************
    Dim strTest as String

    NewChangeIt = Nz(DLookup("WithText", "tblBatchReplace", "ReplaceText " & strtemp), vbNullString)

    If Len(NewChangeIt) Then
       Exit Function
    End If

    Do While Len(strTemp)
       strTest = ParseStr(strTemp)
       NewChangeIt = NewChangeIt & " " & Nz(DLookup("WithText", "tblBatchReplace", "ReplaceText " & strTest), strTest)
    Loop
     
End Function

Function ParseStr(strValue As String) As String
       ' Comments   : pass string to function
       '              returns the first word or item - seperated by space
       '              removes first item from original string and returns new version of string
       ' --------------------------------------------------------
     
       Dim intFindWordEnd As Integer
       Dim strtest As String
       Const gConSpace = " "
       If Len(strValue) Then
       Else
            Exit Function
       End If
     
       strtest = strValue & gConSpace
     
       intFindWordEnd = InStr(strTest, gConSpace)
     
       ParseStr = Trim$(Left$(strtest, intFindWordEnd - 1))
       strValue = LTrim$(Mid$(strtest, intFindWordEnd + 1))
     End Function
     
0
 
TrygveCommented:
Three functions changed. NewChangeIt now handling strings with commas and the two others get their recordset variable "cleaned up" when done. This is to prevent loss of memory and potential closing problems in Access.

Try it and let me know.

Private Function NewChangeIt(strTemp As String) As String
'********************************************************************************
'PURPOSE:  Parse the passed string and replace any word found in look up table
'IN:       String to parse
'OUT:      Altered string
'DATE:     15-sep-1999 Trygve
'UPDATE:    04-jan-2000 Trygve - Anything before the first comma doesn't get looked at!!
'********************************************************************************

Dim rst As Recordset
Dim localTemp As String

Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblBatchReplace ORDER BY Priority, ReplaceText", dbOpenSnapshot)

If rst.EOF Then
    NewChangeIt = strTemp '
    GoTo ExitMe
End If

If InStr(strTemp, ",") > 0 Then
    localTemp = Left(strTemp, InStr(strTemp, ","))
    strTemp = Mid(strTemp, InStr(strTemp, ",") + 1)
    Do Until Left(strTemp, 1) <> " "
        localTemp = localTemp & " "
        strTemp = Mid(strTemp, 2)
    Loop
Else
    localTemp = ""
End If

Do Until rst.EOF
    Do Until InStr(strTemp, rst!ReplaceText) = 0
        strTemp = Left(strTemp, InStr(strTemp, rst!ReplaceText) - 1) & rst!WithText & Mid(strTemp, InStr(strTemp, rst!ReplaceText) + Len(rst!ReplaceText))
    Loop
    rst.MoveNext
Loop

NewChangeIt = localTemp & strTemp


ExitMe:
    rst.Close
    Set rst = Nothing
   
    Exit Function

End Function

Public Function getshort(ByVal strLong As String, strtable As String, p As Page) As String

    Dim rst As Recordset
    Set rst = CurrentDb.OpenRecordset(strtable, dbOpenSnapshot)
    rst.FindFirst "replacetext= '" & strLong & "' AND strTab='" & p.Parent.ControlName & "'  AND strpage='" & p.Name & "'"

    If Not rst.NoMatch Then
        getshort = rst!WithText
    Else
        getshort = strLong
    End If
    rst.Close
    Set rst = Nothing

End Function

Public Function batchShort(strSourcetablename As String, strFieldname As String)
'********************************************************************************
'PURPOSE:   Replace any word in the given field in the given table with a 'short'
'           version from tblBatchreplace if it is there
'Solution: Using a slightly different approach. I pull up the set of replacement alternatives
'             and then loop through them seing if any of them fit.
'             Note that the Priority field in tblBatchReplace can be used to give priority to some
'             replacement alternavis. The rest is sorted by alphabeth
'IN:        Table name. Field name to search
'OUT:       Nothing yet
'DATE:      12 July 1999
'********************************************************************************
    Dim strTemp As String  'variable to hold the 'old' value
    Dim rst As Recordset
    Dim strsql As String
     
    strsql = "select " & strFieldname & " from " & strSourcetablename
    Set rst = CurrentDb.OpenRecordset(strsql, dbOpenDynaset)
    If rst.EOF Then Exit Function
    rst.MoveLast
    rst.MoveFirst
     
    Call SysCmd(acSysCmdInitMeter, "Working", rst.RecordCount)
   
    With rst
        Do While Not .EOF
            Call SysCmd(acSysCmdUpdateMeter, rst.AbsolutePosition)
         
            strTemp = Nz(rst.Fields(strFieldname))
            .Edit
                .Fields(strFieldname) = Trim(NewChangeIt(strTemp))
            .Update
            .MoveNext
        Loop
    End With
    SysCmd (acSysCmdClearStatus)
    rst.Close
    Set rst = Nothing
                       
End Function
0
 
TrygveCommented:
For the record: This is a continued "problem" which we have worked on from time to time. I have a couple of databases made during the process and it is therefore easier for me to assist than for someone who needs to look at it from scratch. Therefore the directed question...
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
JimMorganCommented:
Then perhaps this would be better handled off line with fordraiders awarding you points based on the original problem that you are working on.

As you have told me from time to time, anything put out as a question which is not directly awarding points for work on another question is fair game.

How are you sure that my approach is not a better approach to the problem?  I'd let fordraiders make the decision.

Jim

BTW, where have you been?  Haven't seen you around here much during these late hours for me.  :)
0
 
TrygveCommented:
Jim: You don't have to engage at all the questions you know ;-)

I did not notice that you had posted a comment when I posted my answer. Not even when I posted the second comment did I see your posting so it was not my meaning to overrule you...

One of the problems here is that the values that are to be changed might appear more than once in the string to be searched. This makes it harder to use your DLookup since we need to test each possible "abbreviation" against the string and not the other way around. We also need to check only what is after the first comma, so my suggestion is better than yours here ;-)


You are right, I have said something like "...anything put out as a question which is not directly awarding points for work on another question is fair game.", but I thought we all agree that obivous continuations can be posted with a ref to both the expert and the previous problem. Perhaps this can be done completely off-line and then points being posted afterwards, but I am not sure if there is much to gain from doing that. When other experts jump onto these questions, they are of course entitled to do so, but they cannot expect the questioner to fill them in if he/she wants to continue working with the expert that helped them before.


BUT: You are right that there is not need to change empty values or values that do not change. Here is the updated BatchShort function:

Public Function batchShort(strSourcetablename As String, strFieldname As String)
'********************************************************************************
'PURPOSE:   Replace any word in the given field in the given table with a 'short'
'           version from tblBatchreplace if it is there
'Solution: Using a slightly different approach. I pull up the set of replacement alternatives
'             and then loop through them seing if any of them fit.
'             Note that the Priority field in tblBatchReplace can be used to give priority to some
'             replacement alternavis. The rest is sorted by alphabeth
'IN:        Table name. Field name to search
'OUT:       Nothing yet
'DATE:      12 July 1999
'********************************************************************************
    Dim strTemp As String  'variable to hold the 'old' value
    Dim strNew As String
   
    Dim rst As Recordset
    Dim strsql As String
     
    strsql = "select " & strFieldname & " from " & strSourcetablename & " WHERE Not IsNull(" & strFieldname & ")"
    Set rst = CurrentDb.OpenRecordset(strsql, dbOpenDynaset)
    If rst.EOF Then Exit Function
    rst.MoveLast
    rst.MoveFirst
     
    Call SysCmd(acSysCmdInitMeter, "Working", rst.RecordCount)
   
    With rst
        Do While Not .EOF
            Call SysCmd(acSysCmdUpdateMeter, rst.AbsolutePosition)
         
            strTemp = Nz(rst.Fields(strFieldname))
            strNew = Trim(NewChangeIt(strTemp))
            If .Fields(strFieldname) <> strNew Then
                .Edit
                    .Fields(strFieldname) = strNew
                .Update
            End If
            .MoveNext
        Loop
    End With
    SysCmd (acSysCmdClearStatus)
    rst.Close
    Set rst = Nothing
                       
End Function
0
 
FordraidersAuthor Commented:
Trygve,
Thanks again solution solved for now
fordraiders
0
 
TrygveCommented:
Thank you!

Jim: I forgot about your last question. I have had a very nice and quiet Christmas vacation. I had only used 4 of my vacation days so my wife decided that the computer activity should be kept to a minimum. :-)) In addition to that, things have heated up at work lately so there has been less time to spend "working" at EE. Now I am hopefully back for full...
0
 
JimMorganCommented:
I hardly 'engage' all the questions.  Why one time when I was real busy doing real work, I must have missed a couple dozen questions.  Didn't even get a chance to look at them.  :-))

Now, I just 'check-in' once in a while to keep everybody honest.

Jim
0
 
TrygveCommented:
Jim: How are you getting on with your all-night-at-EE routines? Getting any sleep these days? I find this time of the year to be more demaing on the hours of sleep than the spring/summer and it kind of irritates me...
0
 
JimMorganCommented:
I'm trying to break the habit.  I sit down with the intention of only 'looking' at the email notifications.  I see something of interest, do a little research, write a few words of comment, and whoosh!  4 hours of time are gone.

But if I go to bed at a normal time, I lay there and don't sleep.  Not sure why.

Of course we don't have the long winter nights that you have.  Your body feels the need to sleep because you are not getting enough day light.

I hope to get some 'professional' help for this compulsive behavior.  Trouble is counselors laugh when I tell them my compulsion is to beat Trygve as the top expert in the Access topic.  :-))

Jim
0
 
TrygveCommented:
In the part of Norway where I live, we have daylight as opposed to the norhtern parts where there is little daylight at all at this part of the year. But you are probably right the I don't get enough. The light in my office and in front of the TV at home does not compensate for the fewer hours of light outside. Perhaps I should spend more time outdoor? Dreadful thought :-)

Good luck on your compulsion...
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now