Purpose of the script... to locate a Part# in a file named "catalog Pricing.xls"
and return the
pricing for that part#.....
Problem:
Only problem with the Script is..... when it searches for a part# like "NAK"
it will return
the pricing from ANY part number with NAK in it... I only want it to find NAK
not NAK-123
or NAKFF and so on....
I was hoping this would not be hard at all for someone to fix.... Attached is
the Script....
Here is the script
_______________________________________________________________________
Attribute VB_Name = "Module1"
Sub AR()
Attribute AR.VB_Description = "3/12/06 BR"
Attribute AR.VB_ProcData.VB_Invoke_Func = "t\n14"
' 3/12/06 BR
' Keyboard Shortcut: Ctrl+t
Dim s As Range
Dim i As Long, ps_index As Long
Dim ps As Worksheet
Set s = Selection
Set ps = Application.Workbooks("catalog PRICING.xls").Sheets(1)
For i = 1 To s.Count
ps_index = index_on_pricing(id:=s.Item(i).Text)
If ps_index <> -1 Then
If (ps.Cells(ps_index + i - 1, 3).Value = "Discontinued") Then
If (MsgBox(s.Item(i).Text & " is discontinued!" & vbCrLf &
"Continue?", vbYesNo)
<> vbNo) Then
Exit For
End If
End If
Cells(s.Item(i).Row, 8).Value = ps.Cells(ps_index, 4)
Cells(s.Item(i).Row, 9).Value = ps.Cells(ps_index, 5)
Cells(s.Item(i).Row, 10).Value = ps.Cells(ps_index, 6)
Cells(s.Item(i).Row, 11).Value = ps.Cells(ps_index, 7)
Cells(s.Item(i).Row, 12).Value = ps.Cells(ps_index, 8)
Cells(s.Item(i).Row, 13).Value = ps.Cells(ps_index, 9)
Cells(s.Item(i).Row, 14).Value = ps.Cells(ps_index, 10)
Cells(s.Item(i).Row, 15).Value = ps.Cells(ps_index, 11)
Cells(s.Item(i).Row, 16).Value = ps.Cells(ps_index, 12)
format_cell_money Cells(s.Item(i).Row, 8)
format_cell_money Cells(s.Item(i).Row, 9)
format_cell_money Cells(s.Item(i).Row, 10)
format_cell_money Cells(s.Item(i).Row, 11)
format_cell_money Cells(s.Item(i).Row, 12)
format_cell_multi Cells(s.Item(i).Row, 13)
format_cell_multi Cells(s.Item(i).Row, 14)
format_cell_multi Cells(s.Item(i).Row, 15)
format_cell_multi Cells(s.Item(i).Row, 16)
If Cells(s.Item(i).Row, 3).Value <> Cells(s.Item(i).Row, 8).Value
Then
Cells(s.Item(i).Row, 8).Font.ColorIndex = 3
End If
If Cells(s.Item(i).Row, 4).Value <> Cells(s.Item(i).Row, 9).Value
Then
Cells(s.Item(i).Row, 9).Font.ColorIndex = 3
End If
If Cells(s.Item(i).Row, 5).Value <> Cells(s.Item(i).Row, 10).Value
Then
Cells(s.Item(i).Row, 10).Font.ColorIndex = 3
End If
If Cells(s.Item(i).Row, 6).Value <> Cells(s.Item(i).Row, 11).Value
Then
Cells(s.Item(i).Row, 11).Font.ColorIndex = 3
End If
End If
Next
End Sub
Sub format_cell_money(c As Variant)
With c
.NumberFormat = "$#,##0.00"
.Font.Name = "Helv"
.Font.Size = 8
..Font.Strikethrough = False
..Font.Superscript = False
..Font.Subscript = False
..Font.OutlineFont = False
..Font.Shadow = False
.Font.Underline = xlUnderlineStyleNone
.Font.ColorIndex = 0
End With
End Sub
Sub format_cell_multi(c As Variant)
With c
.Font.Name = "Helv"
..Font.Size = 8
.Font.Strikethrough = False
.Font.Superscript = False
.Font.Subscript = False
.Font.OutlineFont = False
..Font.Shadow = False
.Font.Underline = xlUnderlineStyleNone
.Font.ColorIndex = 0
End With
End Sub
Function index_on_pricing(id As String)
Dim v As Variant
'v = Application.Workbooks("catalog
PRICING.xls").Sheets(1).Range("a1:a30000").Find
(What:=id)
If Application.Workbooks("catalog
PRICING.xls").Sheets(1).Range("a1:a30000").Find
(What:=id) Is Nothing Then
index_on_pricing = -1
Else
index_on_pricing = Application.Workbooks("catalog
PRICING.xls").Sheets(1).Range
("a1:a30000").Find(What:=id).Row
End If
End Function