M
mithu
i have no idea why but when i run a specific macro the vba editor
comes up.. there is no errors.. no lines are highlighted nothing.. it
just comes up.. and its only when i run this specific set of code.
none of my other modules are giving me any problems..
anyone have any idea why?
here is the code.
Option Explicit
Dim itemnumber As Integer
Dim Mnumber As Integer
Dim implementTotal As Currency
Dim creditsTotal As Integer
Dim enduserTotal As Currency
Dim AppTotal As Currency
Dim wituTotal As Currency
'itemnumber = 1
Dim aryIName() As String
Dim aryIQty() As Integer
Dim aryIPrice() As Variant
Dim aryITotal() As Variant
'material codes
Dim aryMCode() As String
Dim aryMName() As String
Dim aryMqty() As Variant
Dim aryMprice() As Variant
Dim aryMTotal() As Variant
'training
Dim aryTcredits() As Integer
Dim aryTdays() As Integer
'end user onsite
Dim aryEndUserDays() As Integer
Dim aryEndusercost() As Currency
'application onsite
Dim aryAppdays() As Integer
Dim aryAppcost() As Currency
'wit u training
Dim aryWitdays() As Integer
Dim arywitcost() As Currency
Dim allTcredits As Integer
Dim allTCosts As Currency
Dim allenduserdays As Integer
Dim allendusercost As Currency
Dim allappdays As Integer
Dim allappcost As Currency
Dim allwitdays As Integer
Dim allwitcost As Currency
'wfm train
Dim wfmTcredits As Integer
Dim wfmTCosts As Currency
Dim wfmenduserdays As Integer
Dim wfmendusercost As Currency
Dim wfmappdays As Integer
Dim wfmappcost As Currency
Dim wfmwitdays As Integer
Dim wfmwitcost As Currency
Dim wfmcost As Currency
Dim wfmdays As Integer
Dim wfmcredit As Integer
'cscm train
Dim cscmTcredits As Integer
Dim cscmTCosts As Currency
Dim cscmenduserdays As Integer
Dim cscmendusercost As Currency
Dim cscmappdays As Integer
Dim cscmappcost As Currency
Dim cscmwitdays As Integer
Dim cscmwitcost As Currency
Dim cscmcost As Currency
Dim cscmdays As Integer
Dim cscmcredit As Integer
Sub firstrun()
itemnumber = 1
Mnumber = 1
ReDim aryIName(itemnumber)
ReDim aryIQty(itemnumber)
ReDim aryIPrice(itemnumber)
ReDim aryITotal(itemnumber)
ReDim aryMCode(Mnumber)
ReDim aryMName(Mnumber)
ReDim aryMqty(Mnumber)
ReDim aryMprice(Mnumber)
ReDim aryMTotal(Mnumber)
Call zeroout 'zero out all numbers
'uncomment line below after test
Call clearall
Call GetItems
Call getmaterialcodes
Call wfmtraining
Call cscm
Call printitems
Call print_training
Call Totals
Call printsheet
End Sub
Sub getmaterialcodes()
Dim scanrownum As Integer
Dim totalprice As Currency
Application.Goto reference:="mfirst"
scanrownum = ActiveCell.Row
findquant:
If scanrownum = 71 Then
Exit Sub
End If
If Selection.Value = 0 Or "FALSE" Then
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
ElseIf Selection.Value > 0 Then
'start filling arrays
aryMCode(Mnumber) = Range("A" & scanrownum).Value
aryMName(Mnumber) = Range("B" & scanrownum).Value
aryMqty(Mnumber) = Range("C" & scanrownum).Value
If IsNumeric(Range("D" & scanrownum).Value) Then
aryMprice(Mnumber) = Range("D" & scanrownum).Value
'get total item price
totalprice = Range("C" & scanrownum).Value * Range("D" &
scanrownum).Value
aryMTotal(Mnumber) = totalprice
Else
aryMprice(Mnumber) = Range("D" & scanrownum).Value
aryMTotal(Mnumber) = Range("E" & scanrownum).Value
End If
'
'If (Range("C" & scanrownum).Value = "Custom") Or (Range("D" &
scanrownum).Value = "Custom") Then
' totalprice = "Custom"
'Else
' totalprice = Range("C" & scanrownum).Value * Range("D" &
scanrownum).Value
'End If
'update training
allTcredits = allTcredits + Range("F" & scanrownum).Value
allTCosts = allTCosts + Range("G" & scanrownum).Value
allenduserdays = allenduserdays + Range("H" & scanrownum).Value
allendusercost = allendusercost + Range("I" & scanrownum).Value
allappdays = allappdays + Range("J" & scanrownum).Value
allappcost = allappcost + Range("K" & scanrownum).Value
allwitdays = allwitdays + Range("L" & scanrownum).Value
allwitcost = allwitcost + Range("M" & scanrownum).Value
Call upmaterial
End If
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
End Sub
Sub GetItems()
Dim scanrownum As Integer
Dim totalprice As Currency
Scan_Implementation:
Application.Goto reference:="impleservices"
scanrownum = ActiveCell.Row
findquant:
If scanrownum = 96 Then
Exit Sub
End If
If scanrownum = 50 Then
Range("C72").Select
scanrownum = ActiveCell.Row
GoTo findquant
End If
If Selection.Value = 0 Then
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
ElseIf Selection.Value > 0 Then
'start filling arrays
aryIName(itemnumber) = Range("B" & scanrownum).Value
aryIQty(itemnumber) = Range("C" & scanrownum).Value
If IsNumeric(Range("D" & scanrownum).Value) Then
aryIPrice(itemnumber) = Range("D" & scanrownum).Value
'get total item price
totalprice = Range("C" & scanrownum).Value * Range("D" &
scanrownum).Value
aryITotal(itemnumber) = totalprice
implementTotal = implementTotal + totalprice
Else
aryIPrice(itemnumber) = Range("D" & scanrownum).Value
aryITotal(itemnumber) = Range("E" & scanrownum).Value
If IsNumeric(Range("E" & scanrownum).Value) Then
implementTotal = implementTotal + Range("E" &
scanrownum).Value
End If
End If
allTcredits = allTcredits + Range("F" & scanrownum).Value
allTCosts = allTCosts + Range("G" & scanrownum).Value
allenduserdays = allenduserdays + Range("H" & scanrownum).Value
allendusercost = allendusercost + Range("I" & scanrownum).Value
allappdays = allappdays + Range("J" & scanrownum).Value
allappcost = allappcost + Range("K" & scanrownum).Value
allwitdays = allwitdays + Range("L" & scanrownum).Value
allwitcost = allwitcost + Range("M" & scanrownum).Value
Call upitems
End If
'do not get material codes
If scanrownum = 50 Then
Range("C72").Select
scanrownum = ActiveCell.Row
GoTo findquant
End If
'do not get last 2 sections
If scanrownum = 96 Then
Exit Sub
End If
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
End Sub
Sub wfmtraining()
Dim scanrownum As Integer
Scan_Implementation:
Application.Goto reference:="wfm"
scanrownum = ActiveCell.Row
scan:
If scanrownum = 101 Then
wfmcost = wfmwitcost + wfmappcost + wfmendusercost + wfmTCosts
wfmdays = wfmenduserdays + wfmappdays + wfmwitdays
wfmcredit = wfmTcredits
implementTotal = implementTotal + wfmcost
Exit Sub
End If
wfmTcredits = wfmTcredits + Range("F" & scanrownum).Value
wfmTCosts = wfmTCosts + Range("G" & scanrownum).Value
wfmenduserdays = wfmenduserdays + Range("H" & scanrownum).Value
wfmendusercost = wfmendusercost + Range("I" & scanrownum).Value
wfmappdays = wfmappdays + Range("J" & scanrownum).Value
wfmappcost = wfmappcost + Range("K" & scanrownum).Value
wfmwitdays = wfmwitdays + Range("L" & scanrownum).Value
wfmwitcost = wfmwitcost + Range("M" & scanrownum).Value
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
'adding price of wfm training to implementation cost
' implementTotal = implementTotal + wfmTCosts + wfmappcost +
wfmwitcost + wfmendusercost
GoTo scan
End Sub
Sub cscm()
Dim scanrownum As Integer
Scan_Implementation:
Application.Goto reference:="cscm"
scanrownum = ActiveCell.Row
scan:
If scanrownum = 106 Then
cscmcost = cscmwitcost + cscmappcost + cscmendusercost +
cscmTCosts
cscmdays = cscmenduserdays + cscmappdays + cscmwitdays
cscmcredit = cscmTcredits
implementTotal = implementTotal + cscmcost
Exit Sub
End If
cscmTcredits = cscmTcredits + Range("F" & scanrownum).Value
cscmTCosts = cscmTCosts + Range("G" & scanrownum).Value
cscmenduserdays = cscmenduserdays + Range("H" & scanrownum).Value
cscmendusercost = cscmendusercost + Range("I" & scanrownum).Value
cscmappdays = cscmappdays + Range("J" & scanrownum).Value
cscmappcost = cscmappcost + Range("K" & scanrownum).Value
cscmwitdays = cscmwitdays + Range("L" & scanrownum).Value
cscmwitcost = cscmwitcost + Range("M" & scanrownum).Value
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
'implementTotal = implementTotal + cscmTCosts + cscmappcost +
cscmwitcost + cscmendusercost
GoTo scan
End Sub
Sub upmaterial()
Mnumber = Mnumber + 1
ReDim Preserve aryMCode(Mnumber)
ReDim Preserve aryMName(Mnumber)
ReDim Preserve aryMqty(Mnumber)
ReDim Preserve aryMprice(Mnumber)
ReDim Preserve aryMTotal(Mnumber)
End Sub
Sub upitems()
itemnumber = itemnumber + 1
ReDim Preserve aryIName(itemnumber)
ReDim Preserve aryIQty(itemnumber)
ReDim Preserve aryIPrice(itemnumber)
ReDim Preserve aryITotal(itemnumber)
End Sub
Sub moveRight()
ActiveCell.Offset(0, 1).Select
End Sub
Sub movedown()
ActiveCell.Offset(1, 0).Select
End Sub
Sub print_training()
ActiveCell.Value = "Training Summary"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Call makegray
'Call center
Call movedown
ActiveCell.Value = "Name"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Credits"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Days"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Price"
Call unformat
Call makegray
Call center
Call movedown
ActiveCell.Offset(0, -3).Select
ActiveCell.Value = "Training Credits"
Call unformat
Call center
Call movedown
ActiveCell.Value = "End User On-Site"
Call unformat
Call center
Call movedown
ActiveCell.Value = "Applicatoin On-Site"
Call unformat
Call center
Call movedown
ActiveCell.Value = "WIT U"
Call unformat
Call center
Call movedown
ActiveCell.Value = "WFM Training Options: (Not Discountable)"
Call unformat
Call center
Call movedown
ActiveCell.Value = "CSCM and Quality Training Options: (Not
Discountable)"
Call unformat
Call center
ActiveCell.Offset(-5, 1).Select
'insert values
Call unformat
ActiveCell.Value = allTcredits
ActiveCell.Offset(0, 2).Select
Call unformat
ActiveCell.Value = allTCosts
ActiveCell.Offset(1, -1).Select
Call unformat
ActiveCell.Value = allenduserdays
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = allendusercost
ActiveCell.Offset(1, -1).Select
Call unformat
ActiveCell.Value = allappdays
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = allappcost
ActiveCell.Offset(1, -1).Select
Call unformat
ActiveCell.Value = allwitdays
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = allwitcost
ActiveCell.Offset(1, 0).Select
Call unformat
ActiveCell.Value = wfmcost
ActiveCell.Offset(0, -1).Select
Call unformat
ActiveCell.Value = wfmdays
ActiveCell.Offset(0, -1).Select
Call unformat
ActiveCell.Value = wfmcredit
ActiveCell.Offset(1, 0).Select
Call unformat
ActiveCell.Value = cscmcredit
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = cscmdays
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = cscmcost
Call movedown
ActiveCell.Offset(0, -3).Select
Call movedown
End Sub
Sub printitems()
Dim i As Integer
Application.Goto reference:="StartPrint"
'ActiveCell.Offset(1, 0).Select
'print header for items
ActiveCell.Value = "Itemized list"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Call makegray
Call movedown
ActiveCell.Value = "Name"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Quantity"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Price"
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Total"
Call makegray
Call center
Call movedown
ActiveCell.Offset(0, -3).Select
For i = 1 To itemnumber - 1
Call unformat
ActiveCell.Value = aryIName(i)
Call moveRight
Call unformat
ActiveCell.Value = aryIQty(i)
Call center
Call moveRight
Call unformat
ActiveCell.Value = aryIPrice(i)
Call moveRight
Call unformat
ActiveCell.Value = aryITotal(i)
Call movedown
Call unformat
ActiveCell.Offset(0, -3).Select
Next i
Call movedown
ActiveCell.Value = "Material Codes"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Interior.ColorIndex = 15
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
'.ThemeColor = xlThemeColorDark1
'.TintAndShade = -0.249977111117893
'.PatternTintAndShade = 0
End With
Call movedown
Call mheader
ActiveCell.Offset(0, -4).Select
For i = 1 To Mnumber - 1
Call unformat
ActiveCell.Value = aryMCode(i)
Call center
Call moveRight
Call unformat
ActiveCell.Value = aryMName(i)
Call moveRight
Call unformat
ActiveCell.Value = aryMqty(i)
Call moveRight
Call unformat
ActiveCell.Value = aryMprice(i)
Call moveRight
Call unformat
ActiveCell.Value = aryMTotal(i)
Call movedown
Call unformat
ActiveCell.Offset(0, -4).Select
Next i
Call movedown
End Sub
Sub mheader()
ActiveCell.Value = "Material Code Number"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Name"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Quantity"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Price"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Total"
Call unformat
Call makegray
Call center
Call movedown
End Sub
Sub Totals()
Call movedown
ActiveCell.Value = "Total by Material Codes"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Call makegray
'Call center
Call movedown
ActiveCell.Value = "Name"
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Material Code"
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Total"
Call makegray
Call center
Call movedown
ActiveCell.Offset(0, -2).Select
ActiveCell.Value = "Implementation"
Call movedown
ActiveCell.Value = "Training Credits"
Call movedown
ActiveCell.Value = "End User Onsite, Application Onsite, WIT U"
Call movedown
ActiveCell.Offset(-3, 1).Select
ActiveCell.Value = "158235"
Call moveRight
ActiveCell.Value = implementTotal
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = "193457"
Call moveRight
ActiveCell.Value = allTCosts
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = "193456"
Call moveRight
ActiveCell.Value = allendusercost + allappcost + allwitcost
End Sub
Sub center()
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Sub makegray()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 15
'.ThemeColor = xlThemeColorDark1
'.TintAndShade = -0.249977111117893
'.PatternTintAndShade = 0
End With
End Sub
Sub unformat()
With Selection.Interior
.Pattern = xlNone
'.TintAndShade = 0
'.PatternTintAndShade = 0
End With
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.Bold = False
End Sub
Sub clearall()
Sheets("Print Quote Page").Cells.ClearFormats
End Sub
Sub zeroout()
allTcredits = 0
allTCosts = 0
allenduserdays = 0
allendusercost = 0
allappdays = 0
allappcost = 0
allwitdays = 0
allwitcost = 0
wfmTcredits = 0
wfmTCosts = 0
wfmenduserdays = 0
wfmendusercost = 0
wfmappdays = 0
wfmappcost = 0
wfmwitdays = 0
wfmwitcost = 0
wfmcost = 0
wfmdays = 0
wfmcredit = 0
'cscm
cscmTcredits = 0
cscmTCosts = 0
cscmenduserdays = 0
cscmendusercost = 0
cscmappdays = 0
cscmappcost = 0
cscmwitdays = 0
cscmwitcost = 0
cscmcost = 0
cscmdays = 0
cscmcredit = 0
implementTotal = 0
creditsTotal = 0
enduserTotal = 0
AppTotal = 0
wituTotal = 0
End Sub
Sub printsheet()
'ActiveSheet.PrintOut (preview)
Sheets("Print Quote Page").PrintPreview
Sheets("NEW Input").Select
End Sub
comes up.. there is no errors.. no lines are highlighted nothing.. it
just comes up.. and its only when i run this specific set of code.
none of my other modules are giving me any problems..
anyone have any idea why?
here is the code.
Option Explicit
Dim itemnumber As Integer
Dim Mnumber As Integer
Dim implementTotal As Currency
Dim creditsTotal As Integer
Dim enduserTotal As Currency
Dim AppTotal As Currency
Dim wituTotal As Currency
'itemnumber = 1
Dim aryIName() As String
Dim aryIQty() As Integer
Dim aryIPrice() As Variant
Dim aryITotal() As Variant
'material codes
Dim aryMCode() As String
Dim aryMName() As String
Dim aryMqty() As Variant
Dim aryMprice() As Variant
Dim aryMTotal() As Variant
'training
Dim aryTcredits() As Integer
Dim aryTdays() As Integer
'end user onsite
Dim aryEndUserDays() As Integer
Dim aryEndusercost() As Currency
'application onsite
Dim aryAppdays() As Integer
Dim aryAppcost() As Currency
'wit u training
Dim aryWitdays() As Integer
Dim arywitcost() As Currency
Dim allTcredits As Integer
Dim allTCosts As Currency
Dim allenduserdays As Integer
Dim allendusercost As Currency
Dim allappdays As Integer
Dim allappcost As Currency
Dim allwitdays As Integer
Dim allwitcost As Currency
'wfm train
Dim wfmTcredits As Integer
Dim wfmTCosts As Currency
Dim wfmenduserdays As Integer
Dim wfmendusercost As Currency
Dim wfmappdays As Integer
Dim wfmappcost As Currency
Dim wfmwitdays As Integer
Dim wfmwitcost As Currency
Dim wfmcost As Currency
Dim wfmdays As Integer
Dim wfmcredit As Integer
'cscm train
Dim cscmTcredits As Integer
Dim cscmTCosts As Currency
Dim cscmenduserdays As Integer
Dim cscmendusercost As Currency
Dim cscmappdays As Integer
Dim cscmappcost As Currency
Dim cscmwitdays As Integer
Dim cscmwitcost As Currency
Dim cscmcost As Currency
Dim cscmdays As Integer
Dim cscmcredit As Integer
Sub firstrun()
itemnumber = 1
Mnumber = 1
ReDim aryIName(itemnumber)
ReDim aryIQty(itemnumber)
ReDim aryIPrice(itemnumber)
ReDim aryITotal(itemnumber)
ReDim aryMCode(Mnumber)
ReDim aryMName(Mnumber)
ReDim aryMqty(Mnumber)
ReDim aryMprice(Mnumber)
ReDim aryMTotal(Mnumber)
Call zeroout 'zero out all numbers
'uncomment line below after test
Call clearall
Call GetItems
Call getmaterialcodes
Call wfmtraining
Call cscm
Call printitems
Call print_training
Call Totals
Call printsheet
End Sub
Sub getmaterialcodes()
Dim scanrownum As Integer
Dim totalprice As Currency
Application.Goto reference:="mfirst"
scanrownum = ActiveCell.Row
findquant:
If scanrownum = 71 Then
Exit Sub
End If
If Selection.Value = 0 Or "FALSE" Then
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
ElseIf Selection.Value > 0 Then
'start filling arrays
aryMCode(Mnumber) = Range("A" & scanrownum).Value
aryMName(Mnumber) = Range("B" & scanrownum).Value
aryMqty(Mnumber) = Range("C" & scanrownum).Value
If IsNumeric(Range("D" & scanrownum).Value) Then
aryMprice(Mnumber) = Range("D" & scanrownum).Value
'get total item price
totalprice = Range("C" & scanrownum).Value * Range("D" &
scanrownum).Value
aryMTotal(Mnumber) = totalprice
Else
aryMprice(Mnumber) = Range("D" & scanrownum).Value
aryMTotal(Mnumber) = Range("E" & scanrownum).Value
End If
'
'If (Range("C" & scanrownum).Value = "Custom") Or (Range("D" &
scanrownum).Value = "Custom") Then
' totalprice = "Custom"
'Else
' totalprice = Range("C" & scanrownum).Value * Range("D" &
scanrownum).Value
'End If
'update training
allTcredits = allTcredits + Range("F" & scanrownum).Value
allTCosts = allTCosts + Range("G" & scanrownum).Value
allenduserdays = allenduserdays + Range("H" & scanrownum).Value
allendusercost = allendusercost + Range("I" & scanrownum).Value
allappdays = allappdays + Range("J" & scanrownum).Value
allappcost = allappcost + Range("K" & scanrownum).Value
allwitdays = allwitdays + Range("L" & scanrownum).Value
allwitcost = allwitcost + Range("M" & scanrownum).Value
Call upmaterial
End If
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
End Sub
Sub GetItems()
Dim scanrownum As Integer
Dim totalprice As Currency
Scan_Implementation:
Application.Goto reference:="impleservices"
scanrownum = ActiveCell.Row
findquant:
If scanrownum = 96 Then
Exit Sub
End If
If scanrownum = 50 Then
Range("C72").Select
scanrownum = ActiveCell.Row
GoTo findquant
End If
If Selection.Value = 0 Then
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
ElseIf Selection.Value > 0 Then
'start filling arrays
aryIName(itemnumber) = Range("B" & scanrownum).Value
aryIQty(itemnumber) = Range("C" & scanrownum).Value
If IsNumeric(Range("D" & scanrownum).Value) Then
aryIPrice(itemnumber) = Range("D" & scanrownum).Value
'get total item price
totalprice = Range("C" & scanrownum).Value * Range("D" &
scanrownum).Value
aryITotal(itemnumber) = totalprice
implementTotal = implementTotal + totalprice
Else
aryIPrice(itemnumber) = Range("D" & scanrownum).Value
aryITotal(itemnumber) = Range("E" & scanrownum).Value
If IsNumeric(Range("E" & scanrownum).Value) Then
implementTotal = implementTotal + Range("E" &
scanrownum).Value
End If
End If
allTcredits = allTcredits + Range("F" & scanrownum).Value
allTCosts = allTCosts + Range("G" & scanrownum).Value
allenduserdays = allenduserdays + Range("H" & scanrownum).Value
allendusercost = allendusercost + Range("I" & scanrownum).Value
allappdays = allappdays + Range("J" & scanrownum).Value
allappcost = allappcost + Range("K" & scanrownum).Value
allwitdays = allwitdays + Range("L" & scanrownum).Value
allwitcost = allwitcost + Range("M" & scanrownum).Value
Call upitems
End If
'do not get material codes
If scanrownum = 50 Then
Range("C72").Select
scanrownum = ActiveCell.Row
GoTo findquant
End If
'do not get last 2 sections
If scanrownum = 96 Then
Exit Sub
End If
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
GoTo findquant
End Sub
Sub wfmtraining()
Dim scanrownum As Integer
Scan_Implementation:
Application.Goto reference:="wfm"
scanrownum = ActiveCell.Row
scan:
If scanrownum = 101 Then
wfmcost = wfmwitcost + wfmappcost + wfmendusercost + wfmTCosts
wfmdays = wfmenduserdays + wfmappdays + wfmwitdays
wfmcredit = wfmTcredits
implementTotal = implementTotal + wfmcost
Exit Sub
End If
wfmTcredits = wfmTcredits + Range("F" & scanrownum).Value
wfmTCosts = wfmTCosts + Range("G" & scanrownum).Value
wfmenduserdays = wfmenduserdays + Range("H" & scanrownum).Value
wfmendusercost = wfmendusercost + Range("I" & scanrownum).Value
wfmappdays = wfmappdays + Range("J" & scanrownum).Value
wfmappcost = wfmappcost + Range("K" & scanrownum).Value
wfmwitdays = wfmwitdays + Range("L" & scanrownum).Value
wfmwitcost = wfmwitcost + Range("M" & scanrownum).Value
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
'adding price of wfm training to implementation cost
' implementTotal = implementTotal + wfmTCosts + wfmappcost +
wfmwitcost + wfmendusercost
GoTo scan
End Sub
Sub cscm()
Dim scanrownum As Integer
Scan_Implementation:
Application.Goto reference:="cscm"
scanrownum = ActiveCell.Row
scan:
If scanrownum = 106 Then
cscmcost = cscmwitcost + cscmappcost + cscmendusercost +
cscmTCosts
cscmdays = cscmenduserdays + cscmappdays + cscmwitdays
cscmcredit = cscmTcredits
implementTotal = implementTotal + cscmcost
Exit Sub
End If
cscmTcredits = cscmTcredits + Range("F" & scanrownum).Value
cscmTCosts = cscmTCosts + Range("G" & scanrownum).Value
cscmenduserdays = cscmenduserdays + Range("H" & scanrownum).Value
cscmendusercost = cscmendusercost + Range("I" & scanrownum).Value
cscmappdays = cscmappdays + Range("J" & scanrownum).Value
cscmappcost = cscmappcost + Range("K" & scanrownum).Value
cscmwitdays = cscmwitdays + Range("L" & scanrownum).Value
cscmwitcost = cscmwitcost + Range("M" & scanrownum).Value
ActiveCell.Offset(1, 0).Select
scanrownum = ActiveCell.Row
'implementTotal = implementTotal + cscmTCosts + cscmappcost +
cscmwitcost + cscmendusercost
GoTo scan
End Sub
Sub upmaterial()
Mnumber = Mnumber + 1
ReDim Preserve aryMCode(Mnumber)
ReDim Preserve aryMName(Mnumber)
ReDim Preserve aryMqty(Mnumber)
ReDim Preserve aryMprice(Mnumber)
ReDim Preserve aryMTotal(Mnumber)
End Sub
Sub upitems()
itemnumber = itemnumber + 1
ReDim Preserve aryIName(itemnumber)
ReDim Preserve aryIQty(itemnumber)
ReDim Preserve aryIPrice(itemnumber)
ReDim Preserve aryITotal(itemnumber)
End Sub
Sub moveRight()
ActiveCell.Offset(0, 1).Select
End Sub
Sub movedown()
ActiveCell.Offset(1, 0).Select
End Sub
Sub print_training()
ActiveCell.Value = "Training Summary"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Call makegray
'Call center
Call movedown
ActiveCell.Value = "Name"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Credits"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Days"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Price"
Call unformat
Call makegray
Call center
Call movedown
ActiveCell.Offset(0, -3).Select
ActiveCell.Value = "Training Credits"
Call unformat
Call center
Call movedown
ActiveCell.Value = "End User On-Site"
Call unformat
Call center
Call movedown
ActiveCell.Value = "Applicatoin On-Site"
Call unformat
Call center
Call movedown
ActiveCell.Value = "WIT U"
Call unformat
Call center
Call movedown
ActiveCell.Value = "WFM Training Options: (Not Discountable)"
Call unformat
Call center
Call movedown
ActiveCell.Value = "CSCM and Quality Training Options: (Not
Discountable)"
Call unformat
Call center
ActiveCell.Offset(-5, 1).Select
'insert values
Call unformat
ActiveCell.Value = allTcredits
ActiveCell.Offset(0, 2).Select
Call unformat
ActiveCell.Value = allTCosts
ActiveCell.Offset(1, -1).Select
Call unformat
ActiveCell.Value = allenduserdays
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = allendusercost
ActiveCell.Offset(1, -1).Select
Call unformat
ActiveCell.Value = allappdays
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = allappcost
ActiveCell.Offset(1, -1).Select
Call unformat
ActiveCell.Value = allwitdays
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = allwitcost
ActiveCell.Offset(1, 0).Select
Call unformat
ActiveCell.Value = wfmcost
ActiveCell.Offset(0, -1).Select
Call unformat
ActiveCell.Value = wfmdays
ActiveCell.Offset(0, -1).Select
Call unformat
ActiveCell.Value = wfmcredit
ActiveCell.Offset(1, 0).Select
Call unformat
ActiveCell.Value = cscmcredit
ActiveCell.Offset(0, 1).Select
Call unformat
ActiveCell.Value = cscmdays
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = cscmcost
Call movedown
ActiveCell.Offset(0, -3).Select
Call movedown
End Sub
Sub printitems()
Dim i As Integer
Application.Goto reference:="StartPrint"
'ActiveCell.Offset(1, 0).Select
'print header for items
ActiveCell.Value = "Itemized list"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Call makegray
Call movedown
ActiveCell.Value = "Name"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Quantity"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Price"
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Total"
Call makegray
Call center
Call movedown
ActiveCell.Offset(0, -3).Select
For i = 1 To itemnumber - 1
Call unformat
ActiveCell.Value = aryIName(i)
Call moveRight
Call unformat
ActiveCell.Value = aryIQty(i)
Call center
Call moveRight
Call unformat
ActiveCell.Value = aryIPrice(i)
Call moveRight
Call unformat
ActiveCell.Value = aryITotal(i)
Call movedown
Call unformat
ActiveCell.Offset(0, -3).Select
Next i
Call movedown
ActiveCell.Value = "Material Codes"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Interior.ColorIndex = 15
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
'.ThemeColor = xlThemeColorDark1
'.TintAndShade = -0.249977111117893
'.PatternTintAndShade = 0
End With
Call movedown
Call mheader
ActiveCell.Offset(0, -4).Select
For i = 1 To Mnumber - 1
Call unformat
ActiveCell.Value = aryMCode(i)
Call center
Call moveRight
Call unformat
ActiveCell.Value = aryMName(i)
Call moveRight
Call unformat
ActiveCell.Value = aryMqty(i)
Call moveRight
Call unformat
ActiveCell.Value = aryMprice(i)
Call moveRight
Call unformat
ActiveCell.Value = aryMTotal(i)
Call movedown
Call unformat
ActiveCell.Offset(0, -4).Select
Next i
Call movedown
End Sub
Sub mheader()
ActiveCell.Value = "Material Code Number"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Name"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Quantity"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Price"
Call unformat
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Total"
Call unformat
Call makegray
Call center
Call movedown
End Sub
Sub Totals()
Call movedown
ActiveCell.Value = "Total by Material Codes"
Call unformat
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Call makegray
'Call center
Call movedown
ActiveCell.Value = "Name"
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Material Code"
Call makegray
Call center
Call moveRight
ActiveCell.Value = "Total"
Call makegray
Call center
Call movedown
ActiveCell.Offset(0, -2).Select
ActiveCell.Value = "Implementation"
Call movedown
ActiveCell.Value = "Training Credits"
Call movedown
ActiveCell.Value = "End User Onsite, Application Onsite, WIT U"
Call movedown
ActiveCell.Offset(-3, 1).Select
ActiveCell.Value = "158235"
Call moveRight
ActiveCell.Value = implementTotal
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = "193457"
Call moveRight
ActiveCell.Value = allTCosts
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = "193456"
Call moveRight
ActiveCell.Value = allendusercost + allappcost + allwitcost
End Sub
Sub center()
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Sub makegray()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 15
'.ThemeColor = xlThemeColorDark1
'.TintAndShade = -0.249977111117893
'.PatternTintAndShade = 0
End With
End Sub
Sub unformat()
With Selection.Interior
.Pattern = xlNone
'.TintAndShade = 0
'.PatternTintAndShade = 0
End With
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.Bold = False
End Sub
Sub clearall()
Sheets("Print Quote Page").Cells.ClearFormats
End Sub
Sub zeroout()
allTcredits = 0
allTCosts = 0
allenduserdays = 0
allendusercost = 0
allappdays = 0
allappcost = 0
allwitdays = 0
allwitcost = 0
wfmTcredits = 0
wfmTCosts = 0
wfmenduserdays = 0
wfmendusercost = 0
wfmappdays = 0
wfmappcost = 0
wfmwitdays = 0
wfmwitcost = 0
wfmcost = 0
wfmdays = 0
wfmcredit = 0
'cscm
cscmTcredits = 0
cscmTCosts = 0
cscmenduserdays = 0
cscmendusercost = 0
cscmappdays = 0
cscmappcost = 0
cscmwitdays = 0
cscmwitcost = 0
cscmcost = 0
cscmdays = 0
cscmcredit = 0
implementTotal = 0
creditsTotal = 0
enduserTotal = 0
AppTotal = 0
wituTotal = 0
End Sub
Sub printsheet()
'ActiveSheet.PrintOut (preview)
Sheets("Print Quote Page").PrintPreview
Sheets("NEW Input").Select
End Sub