Option Explicit
'?udf_IdentifyLowestCost("A2:A5", "B2:B5", "C2:C5", "D2:D5")
'?udf_IdentifyLowestCost("A2:A5","C2:C5")
'?udf_IdentifyLowestCost("L6:L47","P6:P47","T6:T47","X6:X47")
Public Function udf_IdentifyLowestCost(getSupplier_1 As Variant, _
getSupplier_2 As Variant, _
Optional getSupplier_3 As Variant, _
Optional getSupplier_4 As Variant, _
Optional getSupplier_5 As Variant) As String
' Code created by : Dane A. Miller - https://www.mrexcel.com/board/members/d_miller.454874/#about
Dim rg As Range
Dim sht As Worksheet
Dim arrColNam() As String
Dim i As Long, iUBound As Long
Dim arrHolding() As Variant
Dim arrSorted() As Variant, x As Variant
Dim iColumnNo As Long, iRowNo As Long, iRowCount As Long
Dim j As Long, iCellValue As Double, iCellValue2 As Double
Dim iLowestCellValue() As Variant
Dim cellAddress As String
Dim c As Double
Dim iarrColumName As Integer
Dim outputMsg As String
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
Dim strColumnList As String, colListValue As String
Dim Supplier1ColumnNo As Long, Supplier2ColumnNo As Long, Supplier3ColumnNo As Long, Supplier4ColumnNo As Long, Supplier5ColumnNo As Long
Dim Supplier1ColumnName As String, Supplier2ColumnName As String, Supplier3ColumnName As String, Supplier4ColumnName As String, Supplier5ColumnName As String
Dim SupLowestTotal_1 As Double, SupLowestTotal_2 As Double, SupLowestTotal_3 As Double, SupLowestTotal_4 As Double, SupLowestTotal_5 As Double
Set r1 = Range(getSupplier_1)
Set r2 = Range(getSupplier_2)
With r1
iColumnNo = .Column ' get the number representing the column of the cell.
iRowNo = .Row ' Get the first row of the range of cells
iRowCount = .Rows.Count ' Get the number of rows for the range
End With
Supplier1ColumnNo = r1.Column ' Get the numeric name of the column.
Supplier2ColumnNo = r2.Column ' Get the numeric name of the column.
Supplier1ColumnName = GetCol(Supplier1ColumnNo) ' get the alpha name of the column
Supplier2ColumnName = GetCol(Supplier2ColumnNo) ' get the alpha name of the column
' start building the string to list the column names by starting with the first two mandatory suppliers (column names) before going to optional argument (i.e 3-5 suppliers)
strColumnList = r1.Column
strColumnList = strColumnList & "," & r2.Column
If IsMissing(getSupplier_3) = False Then ' Check to see the there is a 3rd Supplier data which is passed to the funciton.
Set r3 = Range(getSupplier_3)
strColumnList = strColumnList & "," & r3.Column
Supplier3ColumnNo = r3.Column ' Get the alphabetical name of the column.
Supplier3ColumnName = GetCol(Supplier3ColumnNo) ' get the alpha name of the column
End If
If IsMissing(getSupplier_4) = False Then ' Check to see the there is a 4th Supplier data which is passed to the funciton.
Set r4 = Range(getSupplier_4)
strColumnList = strColumnList & "," & r4.Column
Supplier4ColumnNo = r4.Column ' Get the alphabetical name of the column.
Supplier4ColumnName = GetCol(Supplier4ColumnNo) ' get the alpha name of the column
End If
If IsMissing(getSupplier_5) = False Then ' Check to see the there is a 5th Supplier data which is passed to the funciton.
Set r5 = Range(getSupplier_5)
strColumnList = strColumnList & "," & r5.Column
Supplier5ColumnNo = r5.Column ' Get the numeric name of the column.
Supplier5ColumnName = GetCol(Supplier5ColumnNo) ' get the alpha name of the column
End If
arrColNam() = Split(strColumnList, ",") ' pass the column number to an array to loop through later.
ReDim arrHolding(0 To UBound(arrColNam())) ' build the size of the array which would hold the values of the cells as we loop horizontally.
For j = iRowNo To (iRowCount + iRowNo) - 1 'loop down the rows of the Supplier ranges.Basically we looping across and down.
For i = LBound(arrColNam) To UBound(arrColNam) ' loop through the array and output the column names.
iCellValue = Cells(j, CDbl(arrColNam(i))).Value
'Debug.Print j & " : " & iCellValue 'print the row number can cell value horizontally this was just for testing purposes
arrHolding(i) = iCellValue ' as we loop through horizonally pass the values in each cell to the holding array.
colListValue = colListValue & "," & Str(iCellValue) ' this is just used for testing purposes to show all the values in a row once extracted.
Next i
iLowestCellValue = BubbleSrt(arrHolding, True) ' use the function bubblesrt to sort the array and place in a variable to hold.
c = 0
Do Until iLowestCellValue(c) > 0 'Check to make sure the lowest value is not zero. if it is then check the next sequence in the array until a non zero value is found.
c = c + 1
iLowestCellValue(0) = iLowestCellValue(c) 'pass the next vaailable value that is greater than 0 to the array.
Loop
' loop back thought the row and see which cell in the row matches the lowest value.
For i = LBound(arrColNam) To UBound(arrColNam) ' loop through the array and this time we are looking to see which cell matches the lowest data value.
iCellValue2 = Cells(j, CDbl(arrColNam(i))).Value
If (iLowestCellValue(0) = iCellValue2) Then ' look for a match in values and change the color of the cell to yellow
cellAddress = Cells(j, CDbl(arrColNam(i))).Address 'get the address of the cell which matches the lowest value
alterCellColor (cellAddress) ' call the function which adjusts the color of a value which is passed to it.
iarrColumName = Cells(j, CDbl(arrColNam(i))).Column ' match the names which are passed to the column array with the actual excel column and store the lowest value.
If Supplier1ColumnNo = iarrColumName Then 'keep adding the lowest value for each supplier as we loop
SupLowestTotal_1 = SupLowestTotal_1 + iCellValue2
ElseIf Supplier2ColumnNo = iarrColumName Then
SupLowestTotal_2 = SupLowestTotal_2 + iCellValue2
ElseIf Supplier3ColumnNo = iarrColumName Then
SupLowestTotal_3 = SupLowestTotal_3 + iCellValue2
ElseIf Supplier4ColumnNo = iarrColumName Then
SupLowestTotal_4 = SupLowestTotal_4 + iCellValue2
ElseIf Supplier5ColumnNo = iarrColumName Then
SupLowestTotal_5 = SupLowestTotal_5 + iCellValue2
End If
End If
Next i
Debug.Print j & ":- "; Mid(colListValue, 2) & ": in this row the lowest value is " & iLowestCellValue(0) & " in cell - " & cellAddress ' this is for testing purposes only. It shows the extracted row of values and the lowest value in the row
colListValue = "" ' reset the column list.
Next j
outputMsg = "Supplier 1 in column '" & Supplier1ColumnName & "' total in yellow is = " & SupLowestTotal_1
outputMsg = outputMsg & vbNewLine & "Supplier 2 in column '" & Supplier2ColumnName & "' total in yellow is = " & SupLowestTotal_2
If Supplier3ColumnNo <> 0 Then ' build the output string once the parameters are passed (supplier data)
outputMsg = outputMsg & vbNewLine & "Supplier 3 in column '" & Supplier3ColumnName & "' total in yellow is = " & SupLowestTotal_3
End If
If Supplier4ColumnNo <> 0 Then ' build the output string once the parameters are passed (supplier data)
outputMsg = outputMsg & vbNewLine & "Supplier 4 in column '" & Supplier4ColumnName & "' total in yellow is = " & SupLowestTotal_4
End If
If Supplier5ColumnNo <> 0 Then ' build the output string once the parameters are passed (supplier data)
outputMsg = outputMsg & vbNewLine & "Supplier 5 in column '" & Supplier5ColumnName & "' total in yellow is = " & SupLowestTotal_5
End If
udf_IdentifyLowestCost = outputMsg
End Function
Private Function alterCellColor(cellName As String)
'code built from macro which formats the cells.
Range(cellName).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Function
Private Function BubbleSrt(ArrayIn, Ascending As Boolean) As Variant
' https://www.mrexcel.com/board/threads/vba-to-sort-an-array-of-numbers.690718/
' This code is used to sort an array of numbers.
Dim SrtTemp As Variant
Dim i As Long
Dim j As Long
If Ascending = True Then
For i = LBound(ArrayIn) To UBound(ArrayIn)
For j = i + 1 To UBound(ArrayIn)
If ArrayIn(i) > ArrayIn(j) Then
SrtTemp = ArrayIn(j)
ArrayIn(j) = ArrayIn(i)
ArrayIn(i) = SrtTemp
End If
Next j
Next i
Else
For i = LBound(ArrayIn) To UBound(ArrayIn)
For j = i + 1 To UBound(ArrayIn)
If ArrayIn(i) < ArrayIn(j) Then
SrtTemp = ArrayIn(j)
ArrayIn(j) = ArrayIn(i)
ArrayIn(i) = SrtTemp
End If
Next j
Next i
End If
BubbleSrt = ArrayIn
End Function
Private Function GetCol(ColumnNumber) As String
'passed a column number and returns the column name
'https://www.vitoshacademy.com/vba-calculating-column-name-from-number-in-excel-function/
Dim FuncRange As String
Dim FuncColLength As Integer
FuncRange = Cells(1, ColumnNumber).AddressLocal(False, False)
FuncColLength = Len(FuncRange)
GetCol = Left(FuncRange, FuncColLength - 1)
End Function
