MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Need a Quick Fix for my script

  Asked By: Diane    Date: Aug 13    Category: MS Office    Views: 1946

Purpose of the script... to locate a Part# in a file named "catalog Pricing.xls"
and return the
pricing for that part#.....

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
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
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
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
Cells(s.Item(i).Row, 11).Font.ColorIndex = 3
End If
End If
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
If Application.Workbooks("catalog
(What:=id) Is Nothing Then
index_on_pricing = -1
index_on_pricing = Application.Workbooks("catalog

End If
End Function



1 Answer Found

Answer #1    Answered By: William Evans     Answered On: Aug 13

You just need to set the Find function LookAt
parameter to xlWhole. Here is a revised
index_on_pricing function:

Function index_on_pricing(id As String) As Long
Dim Rng As Range
Set Rng = Application.Workbooks("catalog
If Rng Is Nothing Then
index_on_pricing = -1
index_on_pricing = Rng.Row
End If
Set Rng = Nothing
End Function

This only executes the Find once, instead of
potentially twice per your original code. It also
defines the return  value, as every function should.

Didn't find what you were looking for? Find more on Need a Quick Fix for my script Or get search suggestion and latest updates.