- Powershell
- Microsoft Office
- Office 365
- VBA
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
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
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-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.
catalogPRICING.xlsm
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.
catalogPRICING.xlsm
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.
I added the feature to color the quantity red if they don't match.
In your original code, you were copying nine values from the Catalog: five prices and four quantities. I changed it to five of each.
catalogPRICING.xlsb
In your original code, you were copying nine values from the Catalog: five prices and four quantities. I changed it to five of each.
catalogPRICING.xlsb
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!!
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
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
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
I crated a video to explain in detail. https://www.loom.com/share/3a1ee3cd3ba14bea9eecbad2fb9bec94
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.
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
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
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
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
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
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
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.
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
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
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
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
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial