Transforming and quantizing some numbers in a spreadsheet

Question

I have two functions which am currently running separately and would like them to run at once.

The cartMaxCalc calculates and populates column O, then minfinder function uses the calculated values of column O with values of column M to finally set the values of column O.

I am a novice on VBA and would like some pointers on how to refactor this and make it clean.

enter image description here

'Name: Optimum
'Description :
'
'
'
'
'
'Date :
'Team :
'Purpose :
Option Explicit
Option Compare Text
Sub Main()
Application.ScreenUpdating = False
Dim FinalRow As Long
Dim i As Long
'Loop to get cells with values for calculations
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To FinalRow
'Output results to cells and columns
Cells(i, 15).Value = cartMaxCalc(i)
'Write Column Headers
Range("O1").Value = "CART_MAX"
Next
Application.ScreenUpdating = True
End Sub
Public Function cartMaxCalc(i As Long)
Dim quadrantStyle As Variant
Dim cartMx As Long
Dim cartMax1 As Long
Dim stacking As Long
Dim devLoc As Variant
Dim contQty
Set contQty = Cells(i, 6)
Dim contTypeRange
Set contTypeRange = Cells(i, 5)
 ' determine category by first 2 digits of cell
 Select Case UCase(Left(Cells(i, 11).Value, 2))
 Case "E"
 Select Case contTypeRange
 Case "B", "J3", "B0"
 cartMx = 4 * contQty
 Case "C", "C0", "J2", "B2"
 cartMx = 8 * contQty
 Case "C2", "J1", "j4"
 cartMx = 16 * contQty
 Case "D1"
 cartMx = 24 * contQty
 Case "XX", "ZZ"
 cartMx = 0
 Case Else
 cartMx = contQty
 End Select
 Case "G", "P"
 Select Case contTypeRange
 Case "B", "J3", "B0", "D1"
 'do nothing
 Case "C", "C0", "J2"
 cartMx = 6 * contQty
 Case "C2", "J1"
 cartMx = 12 * contQty
 Case "XX", "ZZ"
 cartMx = 0
 Case Else
 cartMx = contQty
 End Select
 Case "T", "F", "R", "L"
 Select Case contTypeRange
 Case "B", "J3", "B0"
 cartMx = 2 * contQty
 Case "C", "C0", "J2", "B2"
 cartMx = 4 * contQty
 Case "C2", "J1"
 cartMx = 8 * contQty
 Case "D1"
 cartMx = 12 * contQty
 Case "XX", "ZZ"
 cartMx = 0
 Case Else
 cartMx = contQty
 End Select
 Case Else
 cartMx = contQty
 End Select
 cartMaxCalc = cartMx
 End Function
Sub minFinder()
Dim ws As Worksheet
Dim rng As Range
Dim minRng As Range
Dim cel As Range
Dim cartmax
Set ws = Sheets("Sheet2") 'will change to activeSheet
With ws
 Set rng = .Range(.Cells(2, 13), .Cells(.Rows.Count, 13).End(xlUp))
 Set minRng = .Range(.Cells(2, 15), .Cells(.Rows.Count, 15).End(xlUp))
End With
For Each cel In rng
 'check column M to find any values that repeat more than twice, find the minimum of the their values in column O
 cartmax = Evaluate("=MIN(IF(" & cel.Address(0, 0) & "=" & rng.Address(0, 0) _
 & "," & minRng.Address(0, 0) & "))")
' determine the final value by which range they fall in.
Select Case cartmax
 Case 0 To 29
 cartmax = 13
 Case 30 To 59
 cartmax = 30
 Case 60 To 119
 cartmax = 60
 Case 120 To 179
 cartmax = 120
 Case 180 To 239
 cartmax = 180
 Case 240 To 299
 cartmax = 240
 Case 300 To 359
 cartmax = 300
 Case 360 To 419
 cartmax = 360
 Case 420 To 479
 cartmax = 420
 Case 480 To 539
 cartmax = 480
 Case 540 To 599
 cartmax = 540
 Case 600 To 659
 cartmax = 600
 Case 660 To 719
 cartmax = 660
 Case 720 To 779
 cartmax = 720
 Case 780 To 839
 cartmax = 780
 Case 840 To 899
 cartmax = 840
 Case 900 To 959
 cartmax = 900
 Case Is >= 960
 cartmax = 960
 End Select
cel.Offset(, 2).Value = cartmax
Next cel
End Sub

• Kaz: By "At once" do you mean "In one subroutine, one after the other?" Because if you actually want 2 inter-dependent subroutines to run in paralell then you're doing it wrong.
• joes: I meant to either have two functions to be called in the main Sub or just call one cartMaxCalc() in the Main sub and have cartMaxCalc() call minFinder()
• Kaz: Then why not just call minfinder at the end of your main sub?
• Kaz: Could you elaborate on what your code is actually doing? I'm trying to figure out what you're trying to calculate, and failing (Hint: Not a good sign). Could you add a short description? A screenshot of your worksheet would also be really useful.
• joes: Am calculating Cart_Max (Last Column in the screenshot). Cartmaxcalc is using multiplying cont_QTY column by a value assigned to Cont_Typ to get the initial value of Cart_MAx column. If values in column UNload appear more than once, then minFinder evaluates the minimum value of the set then overwrites column Cart_Max with the final value. the screen shot is actually a result of the running the code. hope this helps clarify

Answer 1

Just Evaluating the Script, Not the Application of it.

Indentation

I see you have used some indentation in your Public Function cartMaxCalc(i As Long), and pretty good at that, but not the rest of the Subs or Functions. Always make sure that you indent your lines referring to With, For, etc statements.

---

Variable Naming

This is the first place anyone will comment/review (as I am doing). It’s always good to give descriptive names. I know it’s so easy and quick to use For i / j / k to ..... but really just adding a few extra characters never hurt anyone, you also have some good descriptive names cartMaxCalc so you can do it, just need to keep doing it. It will also help the next person in 5 years time.

---

Redo Example

If I had to redo your Main Sub, and I am but no means the best.

Sub PopulatingColumnOWithCartMaxData()
 Application.ScreenUpdating = False
 'Write Column Header
 Range("O1").Value = "CART_MAX"
 Dim FinalRow As Integer
 Dim RowReference As Integer
 'Loop to get cells with values for calculations
 FinalRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 For RowReference = 2 To FinalRow
 'Output results to cells and columns
 ThisWorkbook.Sheets("Sheet1").Cells(RowReference, 15).Value = cartMaxCalc(RowReference)
 Next
 Application.ScreenUpdating = True
End Sub

In the above notice the following:

Descriptive Sub Title

Moving the Column Title Insertion to above the For Loop, as it has nothing to do with the Loop.

Adding the WorkBook and WorkSheet reference to the the various places where Cells(....) is used. If there if another WorkBook was active or another sheet then you could get wrong data.

Using RowReference instead of i. Once a variables has been Dimed then its in the database so then just CTRL + SPACE and start typing and it will appear quickly.

Spacing between ideas in your Sub. Try and have an empty line between parts of your code which then sort of separates the ideas in your Sub.

I also used Integer instead of Long, Integer just doesn’t have a decimal place. More of a preference really.

Also ThunderFrame has some great data here which provides the automatic restoration of the ScreenUpdating and others. If your script bombs out and your have not restored the updating then the user will not know what to do.

---

In the Public Function cartMaxCalc(i As Long)

There are a few Variables which haves been Dim but not used.

When you assigning Values to contQty and contQty you didn’t set the Data Type (Range, String, Long). Also, only if you want to use a Range must you use Set. I would have done the following:

Dim contQty As Double ‘Double has decimal places
contQty = ThisWorkbook.Sheets("Sheet1").Cells(i, 6).Value
Dim contTypeRange As String ' String because it will have Alpha Numerical data
contTypeRange = ThisWorkbook.Sheets("Sheet1").Cells(i, 5).Value

Also change the i to something like CurrentRowReference to be more descriptive. Once in the Function is possible, at first glance, to not see what the i is referring to. Always remember your WorkBook and WorkSheet Reference. If you using the WorkSheet Reference more than twice then I would recommend Setting it up as a variable.

---

In Sub minFinder()

Sub Title is not bad, can just be ..................more descriptive. Dont worry, it has taken me a while to come out of my Non-descriptive ways.

Remember your WorkBook and WorkSheet reference when setting a Range.

Fairly good use of indents.

You did not set the Data Type for cartmax.

Also I am struggling to see what you trying to do with the line:

cartmax = Evaluate("=MIN(IF( " & cel.Address(0, 0) & "=" & rng.Address(0, 0) & "," & minRng.Address(0, 0) & "))")

Firstly, if you want to use the worksheet functions, just use WorksheetFunction. So for your case where you want to use Min then use WorksheetFunction.Min.

• Mathieu Guindon: Nice answer, but Integer is a signed 16-bit value type, which gives it a maximum value of 32,767. Long is 32-bit, which gives it a maximum value that is orders of magnitude greater than Integer; anything that represents an Excel row number should be a Long, to avoid overflow errors... it's not quite a matter of preference ;-)
• joes: Thanks Jean-Pierre, I cleaned-up the code and will be posting it up here soon...

Answer 2

All right, I have some input here. First - your variables. I can't tell what they are for. I'd use

Main

 Dim myWorkbook As Workbook
 Set myWorkbook = ThisWorkbook
 Dim cartWorksheet As Worksheet
 Set cartWorksheet = myWorkbook.Sheets("Sheet1")
 Dim FinalRow As Long
 FinalRow = carworksheet.Cells(Rows.Count, 1).End(xlUp).Row
 Dim currentRow As Long
 Dim currentColumn As Long
 currentColumn = 15 'Column O
 cartWorksheet.Cells(1, currentColumn) = "CART_MAX"
 For currentRow = 2 To FinalRow
 cartWorksheet.Cells(currentRow, currentColumn) = cartMaxCalc(currentRow)

Now we know with what and where we're working

Now we move to cartMaxCalc and I have a couple of questions:

• Why is devLoc defined, I don't see it used anywhere

• Why is your Select Case UCase(Left(Cells(i, 11).Value, 2)) asking for 2 characters when all of your cases have 1 character? I thought maybe they have a null character or something. I'd do it like this -

  Dim myCaseString As String
  'Why are you taking left(string,2) when all your cases have 1 character?
  myCaseString = Trim(UCase(Left(Cells(myRow, myColumn), 2)))
  

• What's the difference between cartMx and cartMax1? Why have the "1" if they don't have the same name (not that that's good practice)? Why have such close names? Oh wait, cartMax1 is never used, so we can get rid of it! Now we just say cartMx is cartMaximum.
• Your function takes an argument, but you don't tell it how to take it. It will assume byRef so instead - Public Function cartMaxCalc(ByVal myRow As Long)
• You never use stacking either
• Or quadrantStyle

So now the beginning of this function looks like this

Public Function cartMaxCalc(ByVal myRow As Long)
 Dim cartMaximum As Long
 Dim myColumn As Long
 myColumn = 11
 Dim myCaseString As String
 'Why are you taking left(string,2) when all your cases have 1 character?
 myCaseString = Trim(UCase(Left(Cells(myRow, myColumn), 2)))
 Dim contQuantity As Range
 Set contQty = Cells(myRow, 6)
 Dim contTypeRange As Range
 Set contTypeRange = Cells(myRow, 5)

Now we get to your CASE selection. As I mentioned, the first level cases all have one character, so why are you getting 2?

The second level of CASE is

select case [range]
 Case "B", "J3", "B0"
 Case "c", "C0, "J2", "B2"
 etc

What are you selecting the range for? And how do the cases apply to it? That goes for all of the cases. Otherwise, the structure of the cases is fine and we return the cartMaximum as the value of the function and pass it back to main.

In terms of calling these two together, let's examine minFinder

What is cartmax doing?

cartmax = Evaluate("=MIN(IF(" & cel.Address(0, 0) & "=" & rng.Address(0, 0) _
 & "," & minRng.Address(0, 0) & "))")

Let my decipher this - if a cell in M column repeats, give the lower value in the respective O column, right? That means we have to do it all after our first loop because we need all of column O. Now I can't put forth a better way to do that if but I would change minFinder to

Public Sub minimumCart(byVal myWorksheet As Worksheet)
 Dim columnOLastRow As Long
 columnOLastRow = myWorksheet.Cells(Rows.Count, 15).End(xlUp).Row
 Dim columnMLastRow As Long
 columnMLastRow = myWorksheet.Cells(Rows.Count, 13).End(xlUp).Row
 Dim myTestColumnO As Range
 Set myTestColumnO = myWorksheet.Range(Cells(2, 15), Cells(columnOLastRow, 15))
 Dim myTestColumnM As Range
 Set myTestColumnM = myWorksheet.Range(Cells(2, 13), Cells(columnMLastRow, 13))
 Dim myCurrentTestCell As Range
 Dim cartmax

So at the end, main looks like this -

Sub Main()
 Application.ScreenUpdating = False
 Dim myWorkbook As Workbook
 Set myWorkbook = ThisWorkbook
 Dim cartWorksheet As Worksheet
 Set cartWorksheet = myWorkbook.Sheets("Sheet1")
 Dim FinalRow As Long
 FinalRow = cartWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
 Dim currentRow As Long
 Dim currentColumn As Long
 currentColumn = 15 'Column O
 cartWorksheet.Cells(1, currentColumn) = "CART_MAX"
 For currentRow = 2 To FinalRow
 cartWorksheet.Cells(currentRow, currentColumn) = cartMaxCalc(currentRow)
 Next
 minFinder (cartWorksheet)
 Application.ScreenUpdating = True
End Sub

One way to refactor it might be that you call for all of each duplicate in column M and then call cartMaxCalc for all of them, returning the minimum.

---

Actually, one way to do this (simplified obviously) would be to use a dictionary to compare values like this -

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
 Dim i As Long
 For i = 1 To lastRow
 If Not dict.exists(Cells(i, 1).Value) Then
 dict.Add Cells(i, 1).Value, Cells(i, 2).Value
 ElseIf Cells(i, 2).Value < dict(Cells(i, 1).Value) Then
 dict(Cells(i, 1).Value) = Cells(i, 2).Value
 End If
 Next

You'd have to calculate O each time, but M would have the lowest value when you went back through and reset O.