Scribd
Upload
151 views9 pages

Manual Handling & Insertion Code

VBA Code to automate the manual handling and insertion table for design for manufacturing within excel

Uploaded by

Zachary Heuss
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
151 views9 pages

Manual Handling & Insertion Code

VBA Code to automate the manual handling and insertion table for design for manufacturing within excel

Uploaded by

Zachary Heuss
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd

Option Explicit

'Author: Zachary Heuss


'Purpose: Calculate manual handling and Insertion times and codes.

Dim HandlingCodes() As Variant


Dim InsertionCodesLoose() As Variant
Dim InsertionCodesSecure() As Variant
Dim InsertionCodesSeparate() As Variant

'Fills table with numbered, bordered cells and populates angle, size,
'and thickness cells with formulas.
Private Sub cmdFillTable_Click()

Dim NumParts As Integer


Dim Count As Integer
Dim RangeString As String

Count = 1
RangeString = ""

NumParts = Range("NumOfParts").Value

Range("A4:R1000").Clear
Range("A4:R1000").[Link] = xlNone

Do
RangeString = "A" & Count + 3
Range(RangeString).Value = Count

Count = Count + 1
Loop Until Count > NumParts

Range("G4").Formula = "=C4 + D4"


Range("G4").[Link] = True
Range("G4").[Link] = True

Range("H4").Formula = "=E4 * 25.4"


Range("H4").[Link] = True
Range("H4").[Link] = True

Range("I4").Formula = "=F4 * 25.4"


Range("I4").[Link] = True
Range("I4").[Link] = True

Range("O4").Formula = "=J4 * (L4 + N4)"


Range("Q4").Formula = "=O4 * 0.4"

Range("G4:I" & 3 + NumParts).FillDown


Range("O4:O" & 3 + NumParts).FillDown
Range("Q4:Q" & 3 + NumParts).FillDown
RangeString = "A4:" & "R" & NumParts + 3

Range(RangeString).[Link] = xlContinuous
Range(RangeString).[Link] = 14

End Sub

Private Sub cmdCalculate_Click()


Dim TotalAngle As Integer
Dim NumOperations As Integer
Dim RangeString As String
Dim Count As Integer
Dim HandleCode As String
Dim InsertCode As String
Dim NumOfParts As Integer
Dim Sizemm As Single
Dim Thickmm As Single

HandlingCodes = [Link]("Handling and


Insertion").Range("B3:K6").Value
InsertionCodesLoose = [Link]("Handling and
Insertion").Range("B10:I12").Value
InsertionCodesSecure = [Link]("Handling and
Insertion").Range("B15:K17").Value
InsertionCodesSeparate = [Link]("Handling and
Insertion").Range("B20:K20").Value

Count = 1
NumOfParts = Range("NumOfParts").Value

Do
TotalAngle = Range("G" & Count + 3).Value
Sizemm = Range("H" & Count + 3).Value
Thickmm = Range("I" & Count + 3).Value

HandleCode = HCodeCalc(TotalAngle, Sizemm, Thickmm)

Range("K" & Count + 3).Value = "'" & HandleCode


Range("L" & Count + 3).Value = HandlingCodes(Left(HandleCode, 1) + 1,
Right(HandleCode, 1) + 1)

If Count = 1 Then
InsertCode = "00"
Else
InsertCode = ICodeCalc()
End If

Range("M" & Count + 3).Value = "'" & InsertCode


If CInt(Left(InsertCode, 1)) < 3 Then
If CInt(Right(InsertCode, 1)) > 3 Then
Range("N" & Count + 3).Value = InsertionCodesLoose(Left(InsertCode,
1) + 1, Right(InsertCode, 1) - 1)
Else
Range("N" & Count + 3).Value = InsertionCodesLoose(Left(InsertCode,
1) + 1, Right(InsertCode, 1) + 1)
End If
ElseIf CInt(Left(InsertCode, 1)) < 6 Then
Range("N" & Count + 3).Value = InsertionCodesSecure(Left(InsertCode, 1)
- 2, Right(InsertCode, 1) + 1)
Else
Range("N" & Count + 3).Value = InsertionCodesSecure(Left(InsertCode, 1)
- 8, Right(InsertCode, 1) + 1)
End If

Count = Count + 1
Loop Until Count > NumOfParts
End Sub

Function HCodeCalc(TotalAngle As Integer, Size As Single, Thick As Single) As


String

Dim HCodeX As Integer


Dim HCodeY As Integer
Dim HCodeFull As String
Dim Answer As Integer

Select Case TotalAngle


Case Is < 360
HCodeX = 0
Case Is < 540
HCodeX = 1
Case Is < 720
HCodeX = 2
Case Else
HCodeX = 3
End Select

Answer = MsgBox("Is the part is easy to handle?", vbYesNo, "Easy?")

If Answer = vbYes Then


If Thick > 2 Then
Select Case Size
Case Is < 6
HCodeY = 2
Case Is < 15
HCodeY = 1
Case Else
HCodeY = 0
End Select
Else
Select Case Size
Case Is > 6
HCodeY = 3
Case Else
HCodeY = 4
End Select
End If
Else
If Thick > 2 Then
Select Case Size
Case Is < 6
HCodeY = 7
Case Is < 15
HCodeY = 6
Case Else
HCodeY = 5
End Select
Else
Select Case Size
Case Is > 6
HCodeY = 8
Case Else
HCodeY = 9
End Select
End If
End If

HCodeFull = HCodeX & HCodeY

HCodeCalc = HCodeFull

End Function

Function ICodeCalc() As String

Dim ICodeX As Integer


Dim ICodeY As Integer
Dim ICodeFull As String
Dim Answer As Integer

Answer = InputBox("Enter 0, 1 or 2| 0: Loose| 1: Immediately Secured| 2:


Seperate Operation", "Insertion Type?")

Select Case Answer


Case Is = 0
ICodeX = InputBox("Enter 0, 1 or 2| 0: Easy to reach| 1: Hard to reach
*or* can't see| 2: Hard to reach *and* can't see", "Accessibility")

Answer = MsgBox("Does part need to be held down?", vbYesNo, "Hold


Down?")

If Answer = vbNo Then


Answer = MsgBox("Is the part easy to align/insert?", vbYesNo,
"Easy?")

If Answer = vbYes Then


Answer = MsgBox("Is there resistance to insertion?", vbYesNo,
"Resistance?")

If Answer = vbYes Then


ICodeY = 1
Else
ICodeY = 0
End If
Else
Answer = MsgBox("Is there resistance to insertion?", vbYesNo,
"Resistance?")

If Answer = vbYes Then


ICodeY = 3
Else
ICodeY = 2
End If
End If
Else
Answer = MsgBox("Is the part easy to align/insert?", vbYesNo,
"Easy?")

If Answer = vbYes Then


Answer = MsgBox("Is there resistance to insertion?", vbYesNo,
"Resistance?")
If Answer = vbYes Then
ICodeY = 7
Else
ICodeY = 6
End If
Else
Answer = MsgBox("Is there resistance to insertion?", vbYesNo,
"Resistance?")

If Answer = vbYes Then


ICodeY = 9
Else
ICodeY = 8
End If
End If
End If
Case Is = 1
ICodeX = InputBox("Enter 0, 1 or 2| 0: Easy to reach| 1: Hard to reach
*or* can't see| 2: Hard to reach *and* can't see", "Accessibility") + 3

Answer = InputBox("Enter 0, 1 or 2| 0: No screw tightening or plastic


deformation| 1: Plastic Deformation| 2: Screw tightening", "Tighening, Deformation
or Neither?")

Select Case Answer


Case Is = 0
Answer = MsgBox("Is the part easy to align/insert?", vbYesNo,
"Easy?")
If Answer = vbYes Then
ICodeY = 0
Else
ICodeY = 1
End If
Case Is = 1
Answer = InputBox("Enter 0 or 1| 0: Plastic bending or torsion|
1: Rivetting or similar opperation", "Deformation Type")
If Answer = 0 Then
Answer = MsgBox("Is the part easy to align/insert?",
vbYesNo, "Easy?")
If Answer = vbYes Then
ICodeY = 2
Else
Answer = MsgBox("Is there resistance to insertion?",
vbYesNo, "Resistance?")
If Answer = vbYes Then
ICodeY = 4
Else
ICodeY = 3
End If
End If
Else
Answer = MsgBox("Is the part easy to align/insert?",
vbYesNo, "Easy?")
If Answer = vbYes Then
ICodeY = 5
Else
Answer = MsgBox("Is there resistance to insertion?",
vbYesNo, "Resistance?")
If Answer = vbYes Then
ICodeY = 7
Else
ICodeY = 6
End If
End If
End If
Case Is = 2
Answer = MsgBox("Is the part easy to align/insert?", vbYesNo,
"Easy?")
If Answer = vbYes Then
ICodeY = 8
Else
ICodeY = 9
End If
End Select
Case Is = 2
ICodeX = 9
Answer = InputBox("Enter 0, 1 or 2| 0: Mechanical fastening processes|
1: Non-mechanical fastening processes| 2: Non-fastening processes", "Type of
Fastening")
Select Case Answer
Case Is = 0
Answer = MsgBox("Does the part experience bulk plastic
deformation?", vbYesNo, "Deformation?")
If Answer = vbYes Then
ICodeY = 3
Else
ICodeY = InputBox("Enter 0, 1 or 2| 0: Bending or similar|
1: Rivetting or similar| 2: Screw tightening or other", "Process?")
End If
Case Is = 1
ICodeY = InputBox("Enter 0 or 1| 0: Metrallurgical Process| 1:
Chemical Process", "Matallurgical or Chemical?")
If Answer = 1 Then
ICodeY = 7
Else
Answer = MsgBox("Is additional material required?",
vbYesNo, "More Material?")
If Answer = vbNo Then
ICodeY = 4
Else
ICodeY = InputBox("Enter 0 or 1| 0: Soldering process|
1: Web/braze processes", "Type of Material?") + 5
End If
End If
Case Is = 2
ICodeY = InputBox("Enter 0 or 1| 0: Manipulation of parts| 1:
Other proceses (taping, liquid insertion, etc.", "What Non-Fastening Process?") + 8
End Select
End Select

ICodeFull = ICodeX & ICodeY

ICodeCalc = ICodeFull
End Function

Private Sub cmdReCalcH_Click()

Dim TotalAngle As Integer


Dim Sizemm As Single
Dim Thickmm As Single
Dim HandleCode As String
Dim Count As Integer
Dim NumOfParts As Integer
Dim RangeString As String

Count = 1

NumOfParts = Range("NumOfParts").Value
HandlingCodes = [Link]("Handling and
Insertion").Range("B3:K6").Value

RangeString = "K4:L" & NumOfParts + 3


Range(RangeString).Clear
Range(RangeString).[Link] = xlContinuous
Range(RangeString).[Link] = 14

Do
TotalAngle = Range("G" & Count + 3).Value
Sizemm = Range("H" & Count + 3).Value
Thickmm = Range("I" & Count + 3).Value

HandleCode = HCodeCalc(TotalAngle, Sizemm, Thickmm)

Range("K" & Count + 3).Value = "'" & HandleCode


Range("L" & Count + 3).Value = HandlingCodes(Left(HandleCode, 1) + 1,
Right(HandleCode, 1) + 1)

Count = Count + 1
Loop Until Count > NumOfParts

End Sub

Private Sub cmdReCalcI_Click()

Dim InsertCode As String


Dim Count As Integer
Dim NumOfParts As Integer
Dim RangeString As String

Count = 1

NumOfParts = Range("NumOfParts").Value
InsertionCodesLoose = [Link]("Handling and
Insertion").Range("B10:I12").Value
InsertionCodesSecure = [Link]("Handling and
Insertion").Range("B15:K17").Value
InsertionCodesSeparate = [Link]("Handling and
Insertion").Range("B20:K20").Value

RangeString = "M4:N" & NumOfParts + 3


Range(RangeString).Clear
Range(RangeString).[Link] = xlContinuous
Range(RangeString).[Link] = 14

Do
If Count = 1 Then
InsertCode = "00"
Else
InsertCode = ICodeCalc()
End If

Range("M" & Count + 3).Value = "'" & InsertCode


If CInt(Left(InsertCode, 1)) < 3 Then
If CInt(Right(InsertCode, 1)) > 3 Then
Range("N" & Count + 3).Value = InsertionCodesLoose(Left(InsertCode,
1) + 1, Right(InsertCode, 1) - 1)
Else
Range("N" & Count + 3).Value = InsertionCodesLoose(Left(InsertCode,
1) + 1, Right(InsertCode, 1) + 1)
End If
ElseIf CInt(Left(InsertCode, 1)) < 6 Then
Range("N" & Count + 3).Value = InsertionCodesSecure(Left(InsertCode, 1)
+ 3, Right(InsertCode, 1) + 1)
Else
Range("N" & Count + 3).Value = InsertionCodesSecure(Left(InsertCode, 1)
- 8, Right(InsertCode, 1) + 1)
End If
Count = Count + 1
Loop Until Count > NumOfParts

End Sub

Private Sub cmdReCalcRow_Click()

Dim RowNum As Integer


Dim TotalAngle As Integer
Dim Sizemm As Single
Dim Thickmm As Single
Dim HandleCode As String
Dim InsertCode As String
Dim RangeString As String

HandlingCodes = [Link]("Handling and


Insertion").Range("B3:K6").Value
InsertionCodesLoose = [Link]("Handling and
Insertion").Range("B10:I12").Value
InsertionCodesSecure = [Link]("Handling and
Insertion").Range("B15:K17").Value
InsertionCodesSeparate = [Link]("Handling and
Insertion").Range("B20:K20").Value

RowNum = InputBox("Please enter the row you would like recalculated:", "What
Row?")

RangeString = "K" & RowNum & ":N" & RowNum


Range(RangeString).Clear
Range(RangeString).[Link] = xlContinuous
Range(RangeString).[Link] = 14

TotalAngle = Range("G" & RowNum).Value


Sizemm = Range("H" & RowNum).Value
Thickmm = Range("I" & RowNum).Value

HandleCode = HCodeCalc(TotalAngle, Sizemm, Thickmm)

Range("K" & RowNum).Value = "'" & HandleCode


Range("L" & RowNum).Value = HandlingCodes(Left(HandleCode, 1) + 1,
Right(HandleCode, 1) + 1)

If RowNum = 1 Then
InsertCode = "00"
Else
InsertCode = ICodeCalc()
End If

Range("M" & RowNum).Value = "'" & InsertCode


If CInt(Left(InsertCode, 1)) < 3 Then
If CInt(Right(InsertCode, 1)) > 3 Then
Range("N" & RowNum).Value = InsertionCodesLoose(Left(InsertCode, 1) +
1, Right(InsertCode, 1) - 1)
Else
Range("N" & RowNum).Value = InsertionCodesLoose(Left(InsertCode, 1) +
1, Right(InsertCode, 1) + 1)
End If
ElseIf CInt(Left(InsertCode, 1)) < 6 Then
Range("N" & RowNum).Value = InsertionCodesSecure(Left(InsertCode, 1),
Right(InsertCode, 1) + 1)
Else
Range("N" & RowNum).Value = InsertionCodesSecure(Left(InsertCode, 1) - 8,
Right(InsertCode, 1) + 1)
End If
End Sub

You might also like