Help my ugly code please

G

Guest

I am trying to do something with VBA and I am not a professional programmer.
I know there are better ways to perform these functions as well as faster...
Can some of you offer direction or correction. Thanks.

Mostly has to do with the GoTo's they aren't the best. This needs to be as
clean and fast as possible because I'll be doing 10,000+ records at one
time...

Option Compare Database

Sub LifeCycleReport()

Dim strDate, strTime, strUser, strBefore, strMM877R5 As String

DoCmd.Hourglass (True)
DoCmd.SetWarnings (False)

'Removes prior information
DoCmd.OpenQuery "qryCleanUpMM887PF5"
DoCmd.OpenQuery "qryCleanUpLife"

DoCmd.TransferText acImportFixed, "MM877PF5IMPORT", "tblMM877R5",
"C:\FILE\File.txt"

Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMM877R5")

'Checks for proper report to import
rs.MoveFirst
strMM877R5 = rs!Field1
If strMM877R5 <> "MM877R5" Then
MsgBox "Not MM877R5", vbExclamation, "NOT MM877R5"
Exit Sub
End If

'Removes Blanks and Headers
DoCmd.OpenQuery "qryRemoveLines"

rs.MoveFirst
Do While Not rs.EOF
strBefore = rs!Field1

If strBefore = "Before" Then
rs.MoveNext
strDate = rs!Field2
strTime = rs!Field3
strUser = rs!Field4
rs.MovePrevious
rs.edit
rs!Field2 = strDate
rs!Field3 = strTime
rs!Field4 = strUser
rs.Update
rs.MoveNext
Else
rs.MoveNext
End If
Loop

rs.Close
Set rs = Nothing

DoCmd.OpenQuery "qryAppendLifeCycle"

Set db = CurrentDb()
Set rs = db.OpenRecordset("tblLifeCycle")

Dim strChangeType As String
Dim strBfrPart, strBfrAccy, strBfrQty, strBfrUOM, strBfrCost As String
Dim strAftPart, strAftAccy, strAftQty, strAftUOM, strAftCost As String

rs.MoveFirst
Do While Not rs.EOF
strChangeType = rs!ChangeType

If strChangeType = "Before" Then
strBfrAccy = rs!Grp_Option & ""
strBfrPart = rs!OldPartNumber & ""
strBfrQty = rs!InitialQuantity & ""
strBfrUOM = rs!UOM & ""
strBfrCost = rs!CurrentCost & ""
rs.MoveNext
strAftAccy = rs!Grp_Option & ""
strAftPart = rs!OldPartNumber & ""
strAftQty = rs!InitialQuantity & ""
strAftUOM = rs!UOM & ""
strAftCost = rs!CurrentCost & ""
rs.MovePrevious

'did part change from basic to accy or vice-versa?
If strBfrAccy <> strAftAccy Then
rs.edit: rs!ChangeType = "DELETED": rs.Update
rs.MoveNext
rs.edit: rs!ChangeType = "ADDED": rs.Update
rs.MoveNext
GoTo 400
End If

'did the part get changed?
If strBfrPart <> strAftPart Then

'did UOM not match the New UOM for this part switch?
If strBfrUOM <> strAftUOM Then
rs.edit: rs!ChangeType = "DELETED"
rs!NewPartNumber = ""
rs.MoveNext
rs.edit: rs!ChangeType = "ADDED"
rs.MoveNext
GoTo 400
End If

rs.edit: rs!ChangeType = "SWITCHED PART"
rs!NewPartNumber = strAftPart
rs!RevisedQuantity = strAftQty
rs!RevisedCost = sftAftCost
rs.MoveNext
rs.Delete
GoTo 400
End If

End If

Dim strCurrentCost, strInitialQty As String

'Copy current cost to rev cost column "DELETED" line
If strChangeType = "DELETED" Then
strCurrentCost = rs!CurrentCost
rs.edit: rs!RevisedCost = strCurrentCost
GoTo 400
End If

'Move qty to new qty and copy current cost to rev cost column
"ADDED" line
If strChangeType = "ADDED" Then
strInitialQty = rs!InitialQty
strCurrentCost = rs!CurrentCost
rs.edit: rs!InitialQty = 0
rs!RevisiedQty = strInitialQty
rs!RevisiedCost = strCurrentCost
GoTo 400
End If

400
Loop


DoCmd.Hourglass (False)
DoCmd.SetWarnings (True)
End Sub
 
G

Guest

Hi Steven:
You will get a faster and better answer if you will isolate a specific area
of code you have a question about. It's hard to know what to address with the
below code.
Thanks,
Sam
 
G

George Nicholson

General Observations:

1) In VB "Dim strDate, strTime, strUser, strBefore, strMM877R5 As String"
will define 4 variants and 1 string (strMM877R5). I doubt that is your
intention.


2) GoTo's are generally frowned upon, except for error handling, because
they lead to "spaghetti" code. Pasta tolerance aside, you might consider
something like the following stucture instead:


Do While Not rs.EOF

Select Case strChangeType

Case "BEFORE"

rs.MovePrevious
.....
If strBfrAccy < strAftAccy Then

. ......
rs.MoveNext
ElseIf strBfrPart < strAftPart Then
If strBfrUOM < strAftUOM Then

........

rs.MoveNext
Else

.......
rs.Delete
End If

End If

Case "DELETED"

...
rs.edit: rs!RevisedCost = strCurrentCost
Case "ADDED" Then

....
rs!RevisedCost = strCurrentCost

Case Else

' Ignore

' If this "can't" happen, you might consider a MsgBox
letting you know that it did.
End Select

Loop


3) Performance would probably be considerably improved if you took advantage
of the "With" construct. it allows you to remove all instances of rs and
just leave the dot or bang (. or !) properties/methods. It speeds code
execution because rs is only evaluated once.

With rs
Do While Not .EOF
strBefore = !Field1
(etc.)
Loop
End With

HTH,
 
G

Guest

This is be the specific section; everything in the Do Loop:

Set db = CurrentDb()
Set rs = db.OpenRecordset("tblLifeCycle")

Dim strChangeType As String
Dim strBfrPart, strBfrAccy, strBfrQty, strBfrUOM, strBfrCost As String
Dim strAftPart, strAftAccy, strAftQty, strAftUOM, strAftCost As String

rs.MoveFirst
Do While Not rs.EOF
strChangeType = rs!Changetype

If strChangeType = "Before" Then
strBfrAccy = rs!Grp_Option & ""
strBfrPart = rs!OldPartNumber & ""
strBfrQty = rs!InitialQuantity & ""
strBfrUOM = rs!UOM & ""
strBfrCost = rs!CurrentCost & ""
rs.MoveNext
strAftAccy = rs!Grp_Option & ""
strAftPart = rs!OldPartNumber & ""
strAftQty = rs!InitialQuantity & ""
strAftUOM = rs!UOM & ""
strAftCost = rs!CurrentCost & ""
rs.MovePrevious

'did part change from basic to accy or vice-versa?
If strBfrAccy <> strAftAccy Then
rs.edit: rs!Changetype = "DELETED"
rs!RevisedCost = strBfrCost: rs.Update: rs.MoveNext
rs.edit: rs!Changetype = "ADDED"
rs!InitialQuantity = 0: rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost: rs.Update: rs.MoveNext
GoTo 400
End If

'did the part get changed?
If strBfrPart <> strAftPart Then

'did UOM not match the New UOM for this part switch?
If strBfrUOM <> strAftUOM Then
rs.edit: rs!Changetype = "DELETED"
rs!RevisedCost = strBfrCost: rs.Update: rs.MoveNext
rs.edit: rs!Changetype = "ADDED"
rs!InitialQuantity = 0: rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost: rs.Update: rs.MoveNext
GoTo 400
End If

rs.edit: rs!Changetype = "SWITCHED PART"
rs!NewPartNumber = strAftPart
rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost
rs.Update: rs.MoveNext: rs.Delete: rs.MoveNext
GoTo 400
End If

'did the price go UP?
If strBfrCost < strAftCost Then
rs.edit: rs!Changetype = "PRICE INCREASE"
rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost
rs.Update: rs.MoveNext: rs.Delete: rs.MoveNext
GoTo 400
End If

'did the price go DOWN?
If strBfrCost > strAftCost Then
rs.edit: rs!Changetype = "PRICE DECREASE"
rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost
rs.Update: rs.MoveNext: rs.Delete: rs.MoveNext
GoTo 400
End If

'did the qty go UP?
If strBfrQty < strAftQty Then
rs.edit: rs!Changetype = "QTY INCREASE"
rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost
rs.Update: rs.MoveNext: rs.Delete: rs.MoveNext
GoTo 400
End If

'did the qty go DOWN?
If strBfrQty > strAftQty Then
rs.edit: rs!Changetype = "QTY DECREASE"
rs!RevisedQuantity = strAftQty
rs!RevisedCost = strAftCost
rs.Update: rs.MoveNext: rs.Delete: rs.MoveNext
GoTo 400
End If



rs.MoveNext
rs.MoveNext
GoTo 400

End If

Dim strCurrentCost, strInitialQty As String

'Copy current cost to rev cost column "DELETED" line
If strChangeType = "DELETED" Then
strCurrentCost = rs!CurrentCost
rs.edit: rs!RevisedCost = strCurrentCost
rs.Update
rs.MoveNext
GoTo 400
End If

'Move qty to new qty and copy current cost to rev cost column
"ADDED" line
If strChangeType = "ADDED" Then
strInitialQty = rs!InitialQuantity
strCurrentCost = rs!CurrentCost
rs.edit: rs!InitialQuantity = 0
rs!RevisedQuantity = strInitialQty
rs!RevisedCost = strCurrentCost
rs.Update
rs.MoveNext
GoTo 400
End If

400
Loop
 
B

Brendan Reynolds

Your code is very hard to read, Steven. In order to offer you any very
specific advise on how to make it more readable, we'd have to read it. But
we don't want to read it, because it is very hard to read - a classic
vicious circle! :-(

In general terms, lose the GoTos, and lose the multi-statement lines (two or
more statements on one line separated by colons) and your code will be much
easier to read. Check out the VBA coding standards at
http://www.xoc.net/standards/rvbacc.asp
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Invalid Use of Null 2

Top