Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need help updating a table with additional data 1

Status
Not open for further replies.

robojeff

Technical User
Dec 5, 2008
220
0
0
US
I have some code that creates records in a table
based upon a part number that is manually typed into
a form (newpn). I have a large list of numbers that I need to
be placed into this table by performing the same calculation
on them instead of typing one number at a time into the form.

Below is my code which takes a part number and strips
out all dashes (pn_nodash) and then that incorporates
a look up table and calculates a type of checksum based
upon the contents of the string of the part number.

Is there an easy way to take the part number from a
table and create the whole list at once instead of
one at a time like it is done in the code below?

thanks

Code:
Dim x As Integer
Dim y As Integer
Dim HIBC As String
Dim partnum As String
Dim totals As Integer
Dim slen As Integer
Dim digit As String
Dim HIBCvals(43) As String
Dim remaindr As Integer
Dim pn_nodash As String
Dim varX As Variant


HIBCvals(0) = "0"
HIBCvals(1) = "1"
HIBCvals(2) = "2"
HIBCvals(3) = "3"
HIBCvals(4) = "4"
HIBCvals(5) = "5"
HIBCvals(6) = "6"
HIBCvals(7) = "7"
HIBCvals(8) = "8"
HIBCvals(9) = "9"
HIBCvals(10) = "A"
HIBCvals(11) = "B"
HIBCvals(12) = "C"
HIBCvals(13) = "D"
HIBCvals(14) = "E"
HIBCvals(15) = "F"
HIBCvals(16) = "G"
HIBCvals(17) = "H"
HIBCvals(18) = "I"
HIBCvals(19) = "J"
HIBCvals(20) = "K"
HIBCvals(21) = "L"
HIBCvals(22) = "M"
HIBCvals(23) = "N"
HIBCvals(24) = "O"
HIBCvals(25) = "P"
HIBCvals(26) = "Q"
HIBCvals(27) = "R"
HIBCvals(28) = "S"
HIBCvals(29) = "T"
HIBCvals(30) = "U"
HIBCvals(31) = "V"
HIBCvals(32) = "W"
HIBCvals(33) = "X"
HIBCvals(34) = "Y"
HIBCvals(35) = "Z"
HIBCvals(36) = "-"
HIBCvals(37) = "."
HIBCvals(38) = " "
HIBCvals(39) = "$"
HIBCvals(40) = "/"
HIBCvals(41) = "+"
HIBCvals(42) = "%"

pn_nodash = Replace(newpn, "-", "")
 
 Me.nodash = pn_nodash

totals = 78                     ' 78 = +m258
slen = Len(pn_nodash)
For x = 1 To slen Step 1
    digit = Mid(pn_nodash, x, 1)
    For y = 0 To 42 Step 1
       If HIBCvals(y) = digit Then
            totals = totals + y
            y = 42
       End If
    Next y
Next x

remaindr = totals Mod 43
digit = HIBCvals(remaindr)


HIBC = "+M258" & pn_nodash & "0" & digit
 

If all what you do is take newpn and calculate HIBC, why don't you crate a little Function that takes newpn and returns HIBC?
Code:
Option Explicit
Dim x As Integer
Dim y As Integer
Dim HIBC As String
Dim partnum As String
Dim totals As Integer
Dim slen As Integer
Dim digit As String
Dim HIBCvals(43) As String
Dim remaindr As Integer
Dim pn_nodash As String
Dim varX As Variant

Private Sub CommandButton1_Click()
Dim i As Integer

For i = 0 To 9
    HIBCvals(i) = i
Next i
For i = 10 To 35
    HIBCvals(i) = Chr(i + 55)
Next i
HIBCvals(36) = "-"
HIBCvals(37) = "."
HIBCvals(38) = " "
HIBCvals(39) = "$"
HIBCvals(40) = "/"
HIBCvals(41) = "+"
HIBCvals(42) = "%"

For i = 1 to rstSomeRecord.RecordCount
    MsgBox FigureHIBC(rstSomeRecord.newpn)
    rstSomeRecord.MoveNext
Next i

End Sub
[blue]
Private Function FigureHIBC(strNewPN As String) As String

pn_nodash = Replace(strNewPN, "-", "")
 
Me.nodash = pn_nodash

totals = 78                     ' 78 = +m258
slen = Len(pn_nodash)
For x = 1 To slen Step 1
    digit = Mid(pn_nodash, x, 1)
    For y = 0 To 42 Step 1
       If HIBCvals(y) = digit Then
            totals = totals + y
            y = 42
       End If
    Next y
Next x

remaindr = totals Mod 43
digit = HIBCvals(remaindr)

FigureHIBC = "+M258" & pn_nodash & "0" & digit

End Function[/blue]
That's just my guess of how the code may look like. You may want to move some declaration of variables

Have fun.

---- Andy
 
Thanks Andy but how can I do the whole list at once instead of entering one part number at a time?

I have over 1500 items to enter and would prefer not to do it manually...
 
I figured it out...

Here is what I added:

Code:
Dim rstProduct As DAO.Recordset
Dim strMsg As String, strTitle As String, statmsg As String
Dim x As Integer
Dim y As Integer
Dim HIBC As String
Dim partnumb As String
Dim totals As Integer
Dim slen As Integer
Dim digit As String
Dim HIBCvals(43) As String
Dim remaindr As Integer

Set dbs = CurrentDb
Set db = CurrentDb

HIBCvals(0) = "0"
HIBCvals(1) = "1"
HIBCvals(2) = "2"
HIBCvals(3) = "3"
HIBCvals(4) = "4"
HIBCvals(5) = "5"
HIBCvals(6) = "6"
HIBCvals(7) = "7"
HIBCvals(8) = "8"
HIBCvals(9) = "9"
HIBCvals(10) = "A"
HIBCvals(11) = "B"
HIBCvals(12) = "C"
HIBCvals(13) = "D"
HIBCvals(14) = "E"
HIBCvals(15) = "F"
HIBCvals(16) = "G"
HIBCvals(17) = "H"
HIBCvals(18) = "I"
HIBCvals(19) = "J"
HIBCvals(20) = "K"
HIBCvals(21) = "L"
HIBCvals(22) = "M"
HIBCvals(23) = "N"
HIBCvals(24) = "O"
HIBCvals(25) = "P"
HIBCvals(26) = "Q"
HIBCvals(27) = "R"
HIBCvals(28) = "S"
HIBCvals(29) = "T"
HIBCvals(30) = "U"
HIBCvals(31) = "V"
HIBCvals(32) = "W"
HIBCvals(33) = "X"
HIBCvals(34) = "Y"
HIBCvals(35) = "Z"
HIBCvals(36) = "-"
HIBCvals(37) = "."
HIBCvals(38) = " "
HIBCvals(39) = "$"
HIBCvals(40) = "/"
HIBCvals(41) = "+"
HIBCvals(42) = "%"

strSQL = "SELECT [HIBCtbl-new].[Part], [HIBCtbl-new].[CleanPN], [HIBCtbl-new].[HIBC] FROM [HIBCtbl-new];"

Set rstProduct = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
Set rstProduct = dbs.OpenRecordset(strSQL, dbOpenDynaset)

If rstProduct.EOF = False Or rstProduct.BOF = False Then rstProduct.MoveFirst    ' Get first record in Table

Do While rstProduct.EOF = False
   cntr = 1
        
   partnum = Trim(rstProduct!CleanPN)
   totals = 78                     ' 78 = +m258
   slen = Len(partnum)
        
    For x = 1 To slen Step 1
      digit = Mid(partnum, x, 1)
      For y = 0 To 42 Step 1
        If HIBCvals(y) = digit Then
            totals = totals + y
            y = 42
        End If
      Next y
   Next x

   remaindr = totals Mod 43
   digit = HIBCvals(remaindr)
   HIBC = "+M258" & partnum & "0" & digit
   
   ' Set the rstProduct!HIBC.Value in the table HIBCtbl-new with calculated value getHIBC
    With rstProduct
        .Edit
        !HIBC = HIBC
        .Update
    End With
    rstProduct.MoveNext     ' get next record
 Loop

End Sub
 

Nice. It is pretty much along the lines of my sollution.

And I see you did not like my version:
[tt]For i = 0 To 9
HIBCvals(i) = i
Next i
For i = 10 To 35
HIBCvals(i) = Chr(i + 55)
Next i
HIBCvals(36) = "-"
HIBCvals(37) = "."
HIBCvals(38) = " "
HIBCvals(39) = "$"
HIBCvals(40) = "/"
HIBCvals(41) = "+"
HIBCvals(42) = "%"
[/tt]
of your many lines of:
[tt]
HIBCvals(0) = "0"
HIBCvals(1) = "1"
HIBCvals(2) = "2"
HIBCvals(3) = "3"
HIBCvals(4) = "4"
...[/tt]

but that's OK :)

Have fun.

---- Andy
 
Ok Andy- Now I see that and yes that is much cleaner...

I'm sorry I missed it because I couldn't see how it updated the table with the new values...
 
What you might want to consider is using Access. It is an SQL environment good at maintaining Access databases. SQL and the relational model were invented so you didn't have to write code like you've been writing.



 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top