PDA

View Full Version : Warehouse control in Excel with VBA



tomjoe
02-19-2008, 01:50 PM
:help I am almost there..
I need this code to accept all digits 0...9, and 5 siffers (like 40921).
I tested and found it accepts 23332 but not f.ex. 33332 or the number 40921. How come ?
I get message "Run-time error ?6?: Overflow...
When the debuger starts it goes to this line in the code:

materialIDCode = UCase(Trim(Range("A" & Target.Row).Value))

I don't know how to debug.

Someone else have written this code and I am unexperienced in VBA codes.

See attachment.......

I appreciate some help.

Bob Phillips
02-19-2008, 02:10 PM
The overflow is caused by uisng Integer not long.

Change



Dim materialIDCode As Integer ' to store 442, 485, etc codes


to




Dim materialIDCode As Long ' to store 442, 485, etc codes


the code can be tidied up too, I will post a suggestion in a minute.

Bob Phillips
02-19-2008, 02:24 PM
Private Sub Worksheet_Change(ByVal Target As Range)
Const MSG_EXISTING As String = _
"You have changed the value of a previously processed entry."
Const MSG_INVALID As String = _
"The entry you made is invalid. Entries must be in the format of L.N " & vbCrLf & _
"where L is one or more letters of the alphabet and N is one or more numeric digits. " & _
"A period is required to separate the Letters from the Numbers."
Const MSG_LOCID As String = _
"The Location Identifier: '<value>'" & vbCrLf & _
"Could not be found on sheet '" & Sheet1Name & "'" & vbCrLf & _
"No Processing Performed"
Const MSG_ITEMID As String = _
"There is no associated Item ID in column A on this row."
Const dateRowID = "DATE"
Dim matchedLocIDAddress As String
Dim destSheet As Worksheet
Dim baseCell As Range
Dim lastRow As Long
Dim startRow As Long
Dim endRow As Long
Dim rOffset As Long
Dim processedFlag As Boolean
Dim materialIDCode As Long ' to store 442, 485, etc codes
Dim msg As String
Dim title As String
Dim ErrFound As Boolean

If Target.Cells.Count = 1 Then
'only 1 cell changed
If Target.Column <> 1 Then

'not in column A, begin processing
If cellValueOnEntry <> 0 Then
msg = MSG_EXISTING: title = "No Action Taken": ErrFound = True

'cell was empty/had value of zero in it before the change, continue processing
ElseIf Not ValidateLocIDFormat(Target) = False Then
msg = MSG_INVALID: title = "Invalid Entry": ErrFound = True

'find matching Location Identifier on Sheet1
ElseIf findLocID(UCase(Trim(Target.Value))) = "" Then
msg = Replace(MSG_LOCID, "<value>", Target.Value): title = "No Match to Location ID": ErrFound = True

'save the material id code number
ElseIf IsEmpty(Range("A" & Target.Row)) Then
msg = MSG_ITEMID: title = "Processing Halted": ErrFound = True

ElseIf Len(UCase(Trim(Range("A" & Target.Row).Value))) = 0 Then
msg = MSG_ITEMID: title = "Processing Stopped": ErrFound = True

End If
If ErrFound Then

MsgBox msg, vbOKOnly, title
Application.EnableEvents = False
Target = ""
cellValueOnEntry = 0
Application.EnableEvents = True
Target.Select
Exit Sub
End If

'we found a match to the Loc ID entered, need to find end of the group
'we can do that by looking from the found row, column A down the sheet until
'we find the word DATE in column A
Set destSheet = ThisWorkbook.Worksheets(Sheet1Name)
Set baseCell = destSheet.Range("A" & Range(matchedLocIDAddress).Row)
startRow = baseCell.Row
lastRow = destSheet.Range("A" & Rows.Count).End(xlUp).Row
rOffset = 0
Do While UCase(Trim(baseCell.Offset(rOffset, 0))) <> dateRowID _
And baseCell.Offset(rOffset, 0).Row < lastRow + 1
rOffset = rOffset + 1
Loop
endRow = baseCell.Row + rOffset
Set baseCell = destSheet.Range(Cells(startRow, Range(matchedLocIDAddress).Column).Address)
rOffset = 0
'find an empty cell or one with zero in it
'endRow points to the DATE row
processedFlag = False
Do While (baseCell.Row + rOffset) < endRow
If IsEmpty(baseCell.Offset(rOffset, 0)) Then
baseCell.Offset(rOffset, 0) = materialIDCode
processedFlag = True
Exit Do ' quit looking
ElseIf baseCell.Offset(rOffset, 0) = 0 Then
baseCell.Offset(rOffset, 0) = materialIDCode
processedFlag = True
Exit Do ' quit looking
End If
rOffset = rOffset + 1
Loop
If processedFlag = True Then
'all that's left to do is to put the date into the date row for the group
destSheet.Range(Cells(endRow, Range(matchedLocIDAddress).Column).Address).NumberFormat = "dd.mm.yy"
destSheet.Range(Cells(endRow, Range(matchedLocIDAddress).Column).Address) = Now()
Else
MsgBox "No empty location found to place the new entry into the group.", vbOKOnly, "Not Processed"
End If
End If ' not in column A test
End If ' cells.count = 1 test
Set baseCell = Nothing
Set destSheet = Nothing
End Sub

tomjoe
02-20-2008, 12:15 AM
I still cannot make it work.
In fact: now I cannot get anything to be transfered to sheet 1.

:doh:

Bob Phillips
02-20-2008, 01:35 AM
Not enough info.

I have absolutely no idea what the whole wokbook is doing, I just found out why you get an overflow.

tomjoe
02-20-2008, 03:42 AM
See the attachment for explanation (sheet 2 / Items)

tomjoe
02-20-2008, 10:47 AM
Hello again :hi:

Sorry !
You were right . . The overflow was caused by using Integer not long.

Your advice fixed it => Dim materialIDCode As Long ' to store 442, 485, etc codes

Now the code accepts all digits.

I still need some guidance to get the code to delete the Location ID in Sheet 1 when deleted from sheet 2 - Also the date for the change must be displayed in sheet 1. Then the code is complete..

See attachment for detailes.

Anyone ?