VBA: find the max and minimum value in multiple columns and the match for the minimum in another col-CodePudding

I am taking first steps in VBA. I am writing a code that retrieves the max and min value of column C (target1) and the value in column A (target2) corresponding to the minimum and paste them in a new sheet. This should be repeated using using as target 1: column F and taget 2: column D, and so on. I have written a code (see below) that works but I believe there must be a cleaner and straightforward way to tackle the problem, maybe with arrays and loop. Can anyone help me? Thanks in advance

`Sub FindMinMax()
 
 Dim minVal As Variant
 Dim maxVal As Variant
 Dim minValInColA As Variant
 
 ' Set the named sheet and the target column
 Dim namedSheet As Worksheet
 Set namedSheet = Sheets("Wells_A")
 Dim tgcol1, tgcol2, tgcol3 As String
 tgcol1 = "C"
 tgcol2 = "F"
 tgcol3 = "I"
 
 ' Find the minimum and maximum values in the target column C
 minVal = Application.WorksheetFunction.Min(namedSheet.Range(tgcol1 & ":" & tgcol1))
 maxVal = Application.WorksheetFunction.Max(namedSheet.Range(tgcol1 & ":" & tgcol1))

 ' Find the minimum value in column A that corresponds to the minimum value in the target column
 minValInColA = Application.WorksheetFunction.Index(namedSheet.Range("A:A"), Application.WorksheetFunction.Match(minVal, namedSheet.Range(tgcol1 & ":" & tgcol1), 0), 1)
 
' Paste the minimum and maximum values in the first column of the new sheet
Sheets("final").Range("B3").Value = minValInColA
Sheets("final").Range("C3").Value = minVal
Sheets("final").Range("D3").Value = maxVal

' Find the minimum and maximum values in the target column F
minVal = Application.WorksheetFunction.Min(namedSheet.Range(tgcol2 & ":" & tgcol2))
maxVal = Application.WorksheetFunction.Max(namedSheet.Range(tgcol2 & ":" & tgcol2))
 
' Find the minimum value in column D that corresponds to the minimum value in the target column
 minValInColA = Application.WorksheetFunction.Index(namedSheet.Range("D:D"), Application.WorksheetFunction.Match(minVal, namedSheet.Range(tgcol2 & ":" & tgcol2), 0), 1)

' Paste the minimum and maximum values in the first column of the new sheet
 Sheets("final").Range("B4").Value = minValInColA
Sheets("final").Range("C4").Value = minVal
Sheets("final").Range("D4").Value = maxVal

' Find the minimum and maximum values in the target column F
minVal = Application.WorksheetFunction.Min(namedSheet.Range(tgcol3 & ":" & tgcol3))
maxVal = Application.WorksheetFunction.Max(namedSheet.Range(tgcol3 & ":" & tgcol3))

' Find the minimum value in column G that corresponds to the minimum value in the target column
minValInColA = Application.WorksheetFunction.Index(namedSheet.Range("G:G"), Application.WorksheetFunction.Match(minVal, namedSheet.Range(tgcol3 & ":" & tgcol3), 0), 1)
 
' Paste the minimum and maximum values in the first column of the new sheet
Sheets("final").Range("B5").Value = minValInColA
Sheets("final").Range("C5").Value = minVal
Sheets("final").Range("D5").Value = maxVal

End Sub`

CodePudding user response：

You are correct, using arrays would shorten the code considerably (although there would be no noticeable difference in performance).

However, from looking at the code it looks like you're working on columns in sets of 3, with every third column (C, F, I are the 3rd, 6th and 9th columns) being searched and corresponding values from two columns before that being returned. So, you don't even need anything as specific as an array, just use a loop with Step 3 to look at every third column.

My suggestion would be:

Sub MinMaxCondensed()
Dim shtFrom As Worksheet, shtTo As Worksheet 'Source and Destination worksheets
Set shtFrom = Sheets("Wells_A"): Set shtTo = Sheets("final")
Dim lCol as Long 'Column variable

With Application.WorksheetFunction
    For lCol = 3 to 9 Step 3
        shtTo.Range("B" & lCol/3   2) = .Index(shtFrom.Columns(lCol-2), .Match(.Min(shtFrom.Columns(lCol)), shtFrom.Columns(lCol))
        shtTo.Range("C" & lCol/3   2) = .Min(shtFrom.Columns(lCol))
        shtTo.Range("D" & lCol/3   2) = .Max(shtFrom.Columns(lCol))
    Next
End With 'Application.WorksheetFunction
End Sub

This way, if you need to look further across shtFrom you can just increase the to value in the Loop and away you go.