Avatar of Aaron Roessler
Aaron Roessler
 asked on

old VBA script needs updated

Back in 2006 I had a friend write me a VBA script that checks pricing and box quantity for my 160+ Excel catalog part# and pricing files. I have a Master List Price Sheet and the VBA script will use the Part# as unique identifier and compare pricing and box quantity to the Master List. it will also copy those rows from the Master List into the Excel sheet into the empty columns on the right in the Single Excel sheet. If the pricing is different it will highlight the copied text red in the Single Excel price sheet.

I created a video to help show and explain how it works.  
NOTE: I need the script to only "Find Entire Cells Only". I currently need to open the Find tool and select that before I run the script.
I also mentioned the Master Price sheet is 4,200 rows when its actually 42,000

PROBLEMS with Script:
1. Now that I am using Mac Excel 2019 v16.31 and not a PC computer,  the script is painfully slow. It was really fast on PC but on Mac takes long time for just one Excel doc thats only 300 rows long.

2. The script only makes the pricing text red if its different, I also need to highlight the box quantity text red if the box quantity is different.

VIDEO: https://www.loom.com/share/cdb5f27e684e44fdbb2cb3acb7165468

The VBA Module script is in the catalogPRICING.xls file
Autotrol-Parts-and-Accessories.xlscatalogPRICING.xls
VBAPCMac OS X

Avatar of undefined
Last Comment
byundt

8/22/2022 - Mon
byundt

I rewrote your code to make it more compact and use fewer statements. I also eliminated the need to use the .Find method (am using Application.Match instead). Those changes should address your first issue (speed). Before I begin making modifications for your second issue, I'd like to make sure that I haven't broken anything.

I assume you run the macro when the AutoTrol-Parts-And-Accessories.xls workbook is active.

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.
catalogPRICING.xlsm
Aaron Roessler

ASKER
WOW!!!  its so fast! and yes it works great so far.  and yes I run the macro when both catalogpricing and any other excel doc is open at same time.
ASKER CERTIFIED SOLUTION
byundt

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Aaron Roessler

ASKER
byundt THANK YOU! I wish I joined Experts Exchange years ago!  This will save much needed Time, and my Eyes from straining. I am Very grateful for your help!!
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
byundt

Aaron,
I'm glad to hear you find Experts Exchange valuable. There are a lot of really good people volunteering their time to help appreciative people like you.

Your questions are clear, and you provide sample data, so it is easy for us to work on your problems. Thank you for taking the time to be such a good Asker.

Brad
Aaron Roessler

ASKER
byundt, I just got my new price list from my boss and started running the script last night and noticed its coloring everything red even though there is no difference. I realized the issue. The price sheet I get has more than 2 decimal places. so $7.24 is actually 7.23639 in Both my Master price list and my individual price sheets.  Can you update your script to allow all decimal places?

I crated a video to explain in detail. https://www.loom.com/share/3a1ee3cd3ba14bea9eecbad2fb9bec94
byundt

I probably should have posted the code in the thread.

What you see below addresses your latest issue by testing for price matching rounded to two decimal places. A difference in the third decimal place that doesn't change the rounding will be ignored. If the difference does change the rounding, it will be turned red. So 3.244 versus 3.246 would be turned red, while 3,244 versus 3.236 would be left alone. This kind of testing tries to pass the eyeball test, so a difference that doesn't affect the values displayed won't be flagged.

The code implements this testing with the VBA Round function, which uses Banker's rounding. VBA Round therefore works a little different than the worksheet ROUND function. ROUND always rounds 5 to the next higher number, while Banker's rounding goes up or down to make it an even number. The examples in the table below make the difference clear:
Value      VBA      ROUND
3.245      3.24      3.25
3.255      3.26      3.26

I could have changed the testing to use the absolute value of the difference in statement 28. In so doing, a price difference of less than 0.005 would be ignored. Only significant price differences would be colored--but there might be changes in the penny digit that don't trigger the red color.
If Abs(.Cells(i, j).Value - .Cells(i, j + 5).Value) >= 0.005 Then .Cells(i, j + 5).Font.ColorIndex = 3

Open in new window

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

Open in new window


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

Open in new window

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Aaron Roessler

ASKER
That fixed it!  we are SO close to having this perfect. but found another small bug. "Type mismtach"  error. This is because in my Master Price list for any Discontinued Part I copy the word Discontinued over all the price columns so that when it gets copied over to my price sheet its easy for me to see which ones are Discontinued. but this throws a mismatch error.

One of these screenshosts is showing the Master Price list and how I copy over the Discontinued through all price columns.
Screen-Shot-2020-02-13-at-11.05.15-A.jpg
Screen-Shot-2020-02-13-at-11.29.29-A.jpg
Aaron Roessler

ASKER
Ok so back to the price and decimal places... Here are a few that are not correctly rounding to match whats in my master price list.
My master price list has these prices
1.28499 and it shows up as $1.28 in master list. but when I ran your macro it shows up as just $1.29 when copied over.
same with:
0.24499 is $0.24 but your macro rounds to $0.25

My workaround is to round all the prices in my Master Price sheet using =ROUND(cell,2) and then copy and paste that value over the originals to get rid of the extra digits.
Actually that does not fix the issue since my Single price sheets also use long numbers for prices 10.03499.

I dont know now to modify your code to round the value from the Master Price list so that 0.24499 is $0.24 when its copied over to my single price sheets.

Can this macro still work by keeping the full amount of digits from my Master Price list when it copies over??  can 0.24499 / $0.24 stay as 0.24499 when its copied into my single price list? currently its showing as 0.25 / $0.25
byundt

The code should not be behaving the way you describe with the values you mentioned. It does not do so in my tests. I'd like to see a sample workbook that illustrates the problem.

Despite the discrepancy between how the code is supposed to act and the way it actually does--it is possible to use the workbook ROUND function to round your data to two decimal places. I did this in two places: the prices that were originally on the Autotrol workbook and also those that were brought over from the Master Price sheet. These two statements were added between statement 27 and 28 in the original code. Having made that change, I no longer needed to round values in the original statement 28. So two new statements, and one changed one.
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

Open in new window

All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Aaron Roessler

ASKER
I tested your latest code and it rounds up which I dont want. The CatalogPRICING attached here is using the 2nd to last code above which is the closest to what i need except for this new round issue.

Maybe there is something else going on I am missing.  Using that most recent code changes 0.24499 to $0.25 both places. Here are the two documents I am working with.
Part#'s with this issue are:
# 700561-08 - 1.28499 / $1.28 but shows up as $1.29 in Brass Fittings - Lead Free.xlsx
# 700060-06 - 0.24499 / $0.24 but shows up as $0.25 in Brass Fittings - Lead Free.xlsx
Brass-Fittings---Lead-Free.xls
CatalogPRICING2020current.xlsb
byundt

There were a number of issues that had to be resolved with the new workbooks.
1. The Part # appeared in different columns
2. The cells for prices may have been pre-formatted with red font color
3. The prices in the master list may include trailing spaces
4. Sometimes the part number is text that looks like a number, and sometimes it is a number stored as a number

I am now getting results that look good to me for both AutoTrol and Brass fittings workbooks.
CatalogPRICING2020current.xlsb
Aaron Roessler

ASKER
Hello again Brad, I need to revisit this thread one last time.  I don't understand when I copy and paste your module script into my new price sheet (saved as xlsb) I get Compile error: Sub or Function not defined.
I finally got it to work a different way in a new excel sheet but then a new issue arrises.  I would greatly appreciate it if you could watch this video that explains everything in detail.
https://www.loom.com/share/14c8691be0414d78af9c812ba430378a

Compile error screenshot
https://pasteboard.co/HE5yc1P3XxZa.jpg

One last quick thing I forgot to mention... your script Rounds my prices into 2 decimal places but its rounding up when I dont want it to. For example: when I use =ROUND(D10726,2) on this price 14.32499 it changes to 14.33 but I need it to be 14.32
A video on that if needed.
https://www.loom.com/share/d7fccf47f9c5445ea29f482076b13f39

I GOT IT WORKING, not ideal but still works, I just used your xlsb doc and deleted all the rows then added the new pricing into your doc. then used =ROUND(cell,2) etc etc.. https://www.loom.com/share/492afdef21414555824f5c193e8320aa
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
aikimark

Aaron

It would be better if you opened a new question, including a link to this prior related question in your text.
byundt

Aaron,
The code assumes that it is installed in a workbook with the master pricing. The first worksheet in that workbook is the one being updated. And the source of the information is the active sheet when you launch the macro.

The most fool-proof way of running the code is to close all workbooks except those two, then to invoke PRICING300 using the ALT+F8 macro selector. If you have two workbooks open, each of which contains a sub with the same name, VBA can get confused trying to figure out which one to use. Closing all other workbooks avoids that issue.

All the code needed is contained in Module1 of the workbook I posted. As I read the code now, you need to copy three of the four routines in that module to your new workbook with master pricing: PRICING300, format_cell_money and index_on_pricing. It doesn't appear as though format_cell_multi is being used, though it doesn't do any harm if you copy that too.

Did you know that you can copy the code just by dragging Module1 from one workbook to another in the VBA Editor? You can also do it by copy and paste like in your video

I watched the video on a cell phone, so may have missed stuff. But it appeared that you were invoking the macro by clicking on the ribbon. Did you have a button there? Or were you using a keyboard shortcut? Either way, which workbook contains the code that it is running? It has to be the workbook with the master pricing sheet you are trying to update.

Regarding the rounding, I commented out the two statements that were doing the rounding. Did you enable them? Also, those statements were using the worksheet function ROUND. If you want to round down, you could use the ROUNDDOWN function instead.

If the above suggestions don't fix your problem, could you please post the workbook with the non-working code as well as the source workbook so I can test at my end?

Brad