Excel VBA Passing Variables - excel

Question

I need to pass the variables max, min, and their respective locations to another sub where it will format each max and min in their respective column. I am trying to create an array that will store the locations and the values but its not working.
I was told to first identify the number of columns used and the number of rows, which is the beginning.
Rows = wsData.UsedRange.Rows.Count
Columns = wsData.UsedRange.Col.Count
j = 1
ReDim Min(j)
With wsData.Range("A3:A19")
For j = 1 To 19 'colum
Min(j) = WorksheetFunction.Min(Range(.Offset(1, j), .Offset(Row, j)))
Max = WorksheetFunction.Max(Range(.Offset(1, j), .Offset(Row, j)))
Min(j) = Min
j = j + 1
ReDim Preserve Min(j) 'saves variables
Next 'next column
End With

Answer 1

The code below uses the ActiveSheet which you need to change to reference the worksheet for your data. Additionally, it assumes that your data starts with Row 1. The code looks at each column in the range and stores the minimum/maximum (it does not account for multiple cells which may share the min or max value) value found in the column as well as the cell's address, in an array and then passes the array to two different subs, one which simply displays the information in a message and one which formats the the background color of the cells. This code does not perform any kind of error handling, but should get you where you want to go.
the line Option Explicit requires that all of the variables be defined using a Dim statement
the line Option Base 1 makes the default starting point for arrays 1 instead of 0
Option Explicit
Option Base 1
Sub GatherData()
Dim iRows As Long
Dim iCols As Long
Dim j As Long
Dim iMin() As Variant
Dim iMax() As Variant
Dim R As Range
iRows = ActiveSheet.UsedRange.Rows.Count
iCols = ActiveSheet.UsedRange.Columns.Count
ReDim iMin(iCols, 2)
ReDim iMax(iCols, 2)
For j = 1 To iCols
Set R = Range(Cells(1, j), Cells(iRows, j)).Find(WorksheetFunction.Min(Range(Cells(1, j), Cells(iRows, j))), LookIn:=xlValues)
iMin(j, 1) = R.Value
iMin(j, 2) = R.Address
Set R = Range(Cells(1, j), Cells(iRows, j)).Find(WorksheetFunction.Max(Range(Cells(1, j), Cells(iRows, j))), LookIn:=xlValues)
iMax(j, 1) = R.Value
iMax(j, 2) = R.Address
Next j
ListMinMax iMax(), True
ListMinMax iMin(), False
FormatMinMax iMax, "green"
FormatMinMax iMin, "yellow"
Set R = Nothing
End Sub
Sub ListMinMax(ByRef Arr() As Variant, ByVal MinMax As Boolean)
Dim strOutput As String
Dim i As Long
If MinMax = True Then
strOutput = "Maximums:" & vbCrLf & vbCrLf
Else
strOutput = "Minimums:" & vbCrLf & vbCrLf
End If
For i = 1 To UBound(Arr, 1)
strOutput = strOutput & "Cell: " & Arr(i, 2) & " = " & Arr(i, 1) & vbCrLf
Next i
MsgBox strOutput, vbOKOnly
End Sub
Sub FormatMinMax(ByRef Arr() As Variant, ByVal BGColor As String)
Dim i As Long
Select Case UCase(BGColor)
Case "GREEN"
For i = 1 To UBound(Arr, 1)
ActiveSheet.Range(Arr(i, 2)).Interior.Color = vbGreen
Next i
Case "YELLOW"
For i = 1 To UBound(Arr, 1)
ActiveSheet.Range(Arr(i, 2)).Interior.Color = vbYellow
Next i
Case Else
MsgBox "Invalid Option", vbCritical
End Select
End Sub
======================================================================
The code below does away with the need for the arrays and formats the color of the min/max values as it finds them
Sub GatherData2()
Dim iRows As Long
Dim iCols As Long
Dim j As Long
Dim R As Range
iRows = ActiveSheet.UsedRange.Rows.Count
iCols = ActiveSheet.UsedRange.Columns.Count
For j = 1 To iCols
Set R = Range(Cells(1, j), Cells(iRows, j)).Find(WorksheetFunction.Min(Range(Cells(1, j), Cells(iRows, j))), LookIn:=xlValues)
R.Interior.Color = vbYellow
Set R = Range(Cells(1, j), Cells(iRows, j)).Find(WorksheetFunction.Max(Range(Cells(1, j), Cells(iRows, j))), LookIn:=xlValues)
R.Interior.Color = vbGreen
Next j
Set R = Nothing
End Sub