asked on
ASKER
ASKER
ASKER
If Abs(.Cells(i, j).Value - .Cells(i, j + 5).Value) >= 0.005 Then .Cells(i, j + 5).Font.ColorIndex = 3
Or I could have looked at the percentage of price difference in statement 28. If certain items are inexpensive on a unit cost basis, you might want to know if they changed in price because you use so many of them. If Abs(.Cells(i, j).Value - .Cells(i, j + 5).Value)/.cells(i, j + 5).Value >= 0.005 Then .Cells(i, j + 5).Font.ColorIndex = 3
Sub PRICING300()
' 3/12/02 BRDim s As Range
Dim i As Long, j As Long, n As Long, partCounts As Long, ps_index As Long
Dim ps As Worksheet
Dim psColA As Range, s As Range
If ActiveSheet.Parent Is ThisWorkbook Then Exit Sub
Set s = ActiveSheet.Range("A1")
Set s = Range(s, s.End(xlDown).Cells(300, 1))
Set ps = ThisWorkbook.Sheets(1)
Set psColA = ps.Range("A1:A50000")
n = s.Count
With s
For i = 1 To n
ps_index = index_on_pricing(.Cells(i).Text, psColA)
If .Cells(i, 1) = "Part #" Then partCounts = i
If ps_index <> -1 Then
.Cells(i, 8).Resize(1, 10).Value = ps.Cells(ps_index, 4).Resize(1, 10).Value
format_cell_money .Cells(i, 8).Resize(1, 9)
For j = 3 To 7
If Round(.Cells(i, j).Value, 2) <> Round(.Cells(i, j + 5).Value, 2) Then .Cells(i, j + 5).Font.ColorIndex = 3
If .Cells(partCounts, j).Value <> .Cells(i, j + 10).Value Then .Cells(i, j + 10).Font.ColorIndex = 3
Next
End If
Next
End With
End Sub
Sub format_cell_money(c As Range)
With c.Font
.Name = "MuktaMahee Regular"
.Size = 9
.Underline = xlUnderlineStyleNone
End With
End Sub
Sub format_cell_multi(c As Range)
With c.Font
.Name = "MuktaMahee Regular"
.Size = 9
.Underline = xlUnderlineStyleNone
End With
End Sub
Function index_on_pricing(id As String, psColA As Range) As Long
Dim v As Variant
v = Application.Match(id, psColA, 0)
index_on_pricing = IIf(IsError(v), -1, v)
End Function
ASKER
ASKER
Sub PRICING300()
' 3/12/02 BRDim s As Range
Dim i As Long, j As Long, n As Long, partCounts As Long, ps_index As Long
Dim ps As Worksheet
Dim psColA As Range, s As Range
If ActiveSheet.Parent Is ThisWorkbook Then Exit Sub
Set s = ActiveSheet.Range("A1")
Set s = Range(s, s.End(xlDown).Cells(300, 1))
Set ps = ThisWorkbook.Sheets(1)
Set psColA = ps.Range("A1:A50000")
n = s.Count
With s
For i = 1 To n
ps_index = index_on_pricing(.Cells(i).Text, psColA)
If .Cells(i, 1) = "Part #" Then partCounts = i
If ps_index <> -1 Then
.Cells(i, 8).Resize(1, 10).Value = ps.Cells(ps_index, 4).Resize(1, 10).Value
format_cell_money .Cells(i, 8).Resize(1, 9)
For j = 3 To 7
If .Cells(i, j).Value <> 0 Then .Cells(i, j).Value = Application.Round(.Cells(i, j).Value, 2)
If .Cells(i, j + 5).Value <> 0 Then .Cells(i, j + 5).Value = Application.Round(.Cells(i, j + 5).Value, 2)
If .Cells(i, j).Value <> .Cells(i, j + 5).Value Then .Cells(i, j + 5).Font.ColorIndex = 3
If .Cells(partCounts, j).Value <> .Cells(i, j + 10).Value Then .Cells(i, j + 10).Font.ColorIndex = 3
Next
End If
Next
End With
End Sub
ASKER
ASKER
Visual Basic for Applications (VBA) enables building user-defined functions (UDFs), automating processes and accessing Windows API and other low-level functionality through dynamic-link libraries (DLLs). VBA is closely related to Visual Basic and uses the Visual Basic Runtime Library, but it can normally only run code within a host application rather than as a standalone program. It can, however, be used to control one application from another via OLE Automation. VBA is built into most Microsoft Office applications.
TRUSTED BY
I assume you run the macro when the AutoTrol-Parts-And-Accesso
The attached file is a .xlsm, which should survive being uploaded to Experts Exchange without being renamed with .doc file extension. Ideally, you will save this file with .xlsb file extension. That will cut its size by a third, and also speed up opening and saving operations.