Problem with nested loops

Question

Hello forum,

I have a problem with the nested loops and also how to populate a dynamic table

In a spreadsheet, I have in column A a continuous series of dates between 01-01-1833 and 31-07-2018. They are considered as text and are in 'yyyymmdd' format. For each date, I have the maximum and minimum temperature of the day.

In the same sheet, I want to create, in VBA, a table showing per year and for each month the maximum temperature of the month.

I tried the nested loops with year and month break but I don't know if the main loop are the years with the months in sub-loop or the reverse. I guess I have to put each temperature of the month in a dynamic table and that calculate the maximum values.

Could a member of the forum give me some ideas to solve this problem.

Thank you in advance for your suggestions.

GiHem

Answer 1

An other way is to use helper columns to pretend a date and a Pivot Table.

D2: =VALUE(LEFT(A2,4))

E2: =DATE(0,VALUE(MID(A2,5,2)),1)

Column E is formatted as MMM

The Pivot table shows the totals (min/max for each year) at the right.

Andreas.

Answer 2

Hi Andreas Killer,

In a word, as in a hundred: thank you.

The VBA module achieves exactly what I wanted. I admit that the problem was more complex than I imagined. I wouldn't have been able to solve it myself. I had been thinking about the pivot-table. But I had rejected this solution because of the dates lower than 01/01/1900. In this case, you also propose a simple but ingenious solution.

Bravo and thank you again.

GiHem

Answer 3

Run the code below in your sample file. The comments in the code explains how it works.

As you have a lot of data, I read the data into an array and process that. And I use arrays also to write the data back into the sheet. That is much faster as if you access each single cell.

Andreas.

Option Explicit

Sub Test()
  Const MaxDouble = 1.79769313486231E+308
  Const MinDouble = -1.79769313486231E+308
  Dim Where As Range
  Dim Data As Variant, Item As Variant
  Dim i As Long
  Dim Y As Integer, M As Integer, LastY As Integer, LastM As Integer
  Dim YMin As Double, YMax As Double, MMin As Double, MMax As Double, This As Double
  Dim YResult As New Collection, MResult As New Collection
  
  'Step 1: Analyze the data
  
  'Read in all data
  Set Where = Range("C2", Range("A" & Rows.Count).End(xlUp))
  Data = Where.Value
  
  'Initialize
  YMin = MaxDouble
  YMax = MinDouble
  MMin = MaxDouble
  MMax = MinDouble
  
  For i = 1 To UBound(Data)
    'Parse the date
    Y = Left(Data(i, 1), 4)
    M = Mid(Data(i, 1), 5, 2)
    
    'Does the year change?
    If LastY <> Y Then
      'First run?
      If LastY > 0 Then
        'Store into the collection
        YResult.Add Array(LastY, LastM, YMin, YMax)
      End If
    End If
    
    'Does the month change?
    If LastM <> M Then
      'First run?
      If LastM > 0 Then
        'Store into the collection
        MResult.Add Array(LastY, LastM, MMin, MMax)
      End If
      'Initialize
      LastM = M
      MMin = MaxDouble
      MMax = MinDouble
    End If
    
    'Initialize
    If LastY <> Y Then
      LastY = Y
      YMin = MaxDouble
      YMax = MinDouble
    End If
    
    'Max value
    If IsNumeric(Data(i, 2)) Then
      This = Data(i, 2)
      If This > YMax Then YMax = This
      If This > MMax Then MMax = This
    End If
    
    'Min value
    If IsNumeric(Data(i, 3)) Then
      This = Data(i, 3)
      If This < YMin Then YMin = This
      If This < MMin Then MMin = This
    End If
  Next
  
  'Grab the last ones
  YResult.Add Array(LastY, LastM, YMin, YMax)
  MResult.Add Array(LastY, LastM, MMin, MMax)
  
  'Step 2: Output
  
  'Clear previous result
  Range("E1").CurrentRegion.Clear
  
  'Create space and headings for the year data
  ReDim Data(0 To YResult.Count, 1 To 3)
  Data(0, 1) = "Year"
  Data(0, 2) = "Min" & ChrW(&H2193)
  Data(0, 3) = "Max" & ChrW(&H2191)
  
  'Compile the year data
  i = 0
  For Each Item In YResult
    i = i + 1
    Data(i, 1) = Item(0) 'Year
    Data(i, 2) = Item(2) 'Min
    Data(i, 3) = Item(3) 'Max
  Next
  
  'Flush into the sheet (Note 1st dimension is zero based)
  Range("E1").Resize(UBound(Data) + 1, UBound(Data, 2)).Value = Data
  
  'Create space and headings for the month data
  'Note: As we have min and max for each month we need 24 slots
  ReDim Data(0 To YResult.Count, 1 To 12 * 2)
  For i = 1 To 12 * 2
    'Abbreviated month name with a up / down arrow
    Data(0, i) = MonthName(i / 2 + 0.1, True) & IIf(i Mod 2, ChrW(&H2193), ChrW(&H2191))
  Next
  
  'Compile the month data
  i = 0
  LastY = 0
  For Each Item In MResult
    Y = Item(0) 'Year
    M = Item(1) * 2 - 1 'Month (corrected to fit the slot)
    'Next row if the year changes
    If LastY <> Y Then
      i = i + 1
      LastY = Y
    End If
    Data(i, M + 0) = Item(2) 'Min
    Data(i, M + 1) = Item(3) 'Max
  Next
  
  'Flush into the sheet (Note 1st dimension is zero based)
  Range("H1").Resize(UBound(Data) + 1, UBound(Data, 2)).Value = Data
End Sub

Answer 4

Hi Andreas Killer,

Thanks for your answer.

You will find a sample file at https://www.cjoint.com/c/HHtiSyU0MJm (private, 4 days)

In the VBE, I tried a solution based on your suggestion.

But a lot of problems remains.

• I'm not sure if the logic is correct
• What do you mean by "collection"? A two dimensional table? In this case, how can I match the year/month of the min or max value and the final table in the worksheet?

Any correction, suggestions or idea's to solve the problem are welcom.

GiHem

Answer 5

You need only one loop. Get the overall min/max during the loop.

Parse the date and check if the month changes. If so, store the year/month with the min/max anywhere, e.g. in a collection.

At the end get the data from the collection and write it into the sheet.

If you need further help please upload your file (maybe with anonymous data) on an online file hoster like www.dropbox.com and post the download link here.

A macro to anonymize data in selected cells can be downloaded here:
https://www.dropbox.com/s/rkfxuh85j5wyj9y/modAn...

Andreas.