Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Private miNextSummaryColumn As Integer
Sub CalculateWeeklyMinAndMax()
Dim iRow As Integer
Dim iColumn As Integer
Dim dtCalcDateCurrent As Date
Dim dtCalcDateNext As Date
Dim strCellValue As String
Dim dblMin As Double
Dim dblMax As Double
miNextSummaryColumn = 10
iRow = 2 ' skip header
dtCalcDateCurrent = getCalcDate(iRow)
dblMin = 99999
dblMax = 0
Do Until Cells(iRow, 1).Value = ""
' Find min and max for the row
For iColumn = 2 To 7
If iColumn <> 6 Then ' skip for "Volume" data
strCellValue = Cells(iRow, iColumn).Value
If Val(strCellValue) < dblMin Then
dblMin = Val(strCellValue)
End If
If Val(strCellValue) > dblMax Then
dblMax = Val(strCellValue)
End If
End If
Next iColumn
iRow = iRow + 1
dtCalcDateNext = getCalcDate(iRow)
If dtCalcDateNext <> dtCalcDateCurrent Then
' New date so show result in summary sheet
ShowResults dtCalcDateCurrent, dblMin, dblMax
dtCalcDateCurrent = dtCalcDateNext
dblMin = 99999
dblMax = 0
End If
Loop
End Sub
Private Function getCalcDate(RowNumber As Integer)
' assumes that column 7 has this formula: =IF(WEEKDAY(A2) <6,A2+(6-WEEKDAY(A2)), A2+7-MOD(WEEKDAY(A2),7)-1)
' if not, then check the date in the first column of the row and figure out the next Friday
getCalcDate = Cells(RowNumber, 8).Value
End Function
Private Sub ShowResults(CalcDate As Date, MinValue As Double, MaxValue As Double)
Sheets("Summary").Cells(1, miNextSummaryColumn).Value = CalcDate
Sheets("Summary").Cells(2, miNextSummaryColumn).Value = MinValue
Sheets("Summary").Cells(3, miNextSummaryColumn).Value = MaxValue
miNextSummaryColumn = miNextSummaryColumn + 1
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.