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
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
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.