Hits, misses and false alarms monthly summary

[drefiek2]

I need help creating a 'verification' monthly summary table and I will try to explain what I want using an example.
I have a spreadsheet with dates in column B starting from row 6 (1st Jan 2025 - 31st Dec 2025), these dates are merged cells over two rows, so rather than 365 rows there are 730 rows.
I have cities in Europe along row 5 columns D to J.
For each date I have 'Sunny Forecast' and 'Observation', what someone will do is forecast whether it will be sunny in those cities on that date and either put a 0 for yes (green flag) or a 1 for no (red flag).
The next day they will verify whether it was sunny or not, by again putting a 0 or 1.
If both are 0 for that date then it is a 'hit', if both are 1 for that date then it is also a 'hit', if the forecast is a 0 but the observation is a 1 then it is a 'miss', if the forecast is a 1 but the observation is a 0 then it is a 'false alarm'. This probably sounds strange but it is just an example!
Essentially what I want to be able to do is in a blank table on another sheet, select a month from a drop down box above the table, and then for the table to auto-populate whether for each date and for each city it was a hit, miss or false alarm, by automatically entering either a H, M or FA in the cell. Again I'd like cities along the top and dates along the side.
I suppose there needs to be an IF formula (with some ISNUMBER statements too) checking whether cells are equal, more than or less than 0 or 1? Or is there a better way to do it, I've got no idea, so any help would be very much appreciated.
Hopefully that makes sense, I've attached a screenshot of the top of the spreadsheet for reference.

 

[Sam_D_Ben]

Assuming your forecast data is located in the "ForecastData" sheet, and the output to be displayed in the "Summary" sheet. When you enter a month in cell B1 of the "Summary" sheet, the corresponding output is generated accordingly like below with your conditions. Is this what you are looking for? You want to try VBA

Forcast Data.xlsm
	B	C	D	E	F	G	H	I	J
5	Date	Type	London	Berlin	Paris	Madrid	Athens	Lisbon	Rome
6	1/1/2025	Sunny Forecast	0	0	1	1	0	1	1
7		Observation	1	0	1	0	0	1	1
8	1/2/2025	Sunny Forecast	0	1	0	0	1	0	0
9		Observation	1	1	0	1	1	0	1
10	1/3/2025	Sunny Forecast	1	1	0	0	1	1	0
11		Observation	1	0	1	1	0	0	1
ForecastData

Forcast Data.xlsm
	A	B	C	D	E	F	G	H	I
1	Month	January
2	Date	Type	London	Berlin	Paris	Madrid	Athens	Lisbon	Rome
3	1/1/2025	Sunny Forecast	M	H	H	FA	H	H	H
4		Observation
5	1/2/2025	Sunny Forecast	M	H	H	M	H	H	M
6		Observation
7	1/3/2025	Sunny Forecast	H	FA	M	M	FA	FA	M
8		Observation
Summary

 

[drefiek2]

Assuming your forecast data is located in the "ForecastData" sheet, and the output to be displayed in the "Summary" sheet. When you enter a month in cell B1 of the "Summary" sheet, the corresponding output is generated accordingly like below with your conditions. Is this what you are looking for? You want to try VBA

Forcast Data.xlsm
	B	C	D	E	F	G	H	I	J
5	Date	Type	London	Berlin	Paris	Madrid	Athens	Lisbon	Rome
6	1/1/2025	Sunny Forecast	0	0	1	1	0	1	1
7		Observation	1	0	1	0	0	1	1
8	1/2/2025	Sunny Forecast	0	1	0	0	1	0	0
9		Observation	1	1	0	1	1	0	1
10	1/3/2025	Sunny Forecast	1	1	0	0	1	1	0
11		Observation	1	0	1	1	0	0	1
ForecastData

Forcast Data.xlsm
	A	B	C	D	E	F	G	H	I
1	Month	January
2	Date	Type	London	Berlin	Paris	Madrid	Athens	Lisbon	Rome
3	1/1/2025	Sunny Forecast	M	H	H	FA	H	H	H
4		Observation
5	1/2/2025	Sunny Forecast	M	H	H	M	H	H	M
6		Observation
7	1/3/2025	Sunny Forecast	H	FA	M	M	FA	FA	M
8		Observation
Summary

Yes that is exactly what I am looking for, I am just not sure what VBA code or formulas I need to do it, are you able to help with it? I have never written any VBA from scratch before and I'm not sure where to start.

 

[Sam_D_Ben]

Please try this, [Sheet names and ranges should be considered]

Sub ForecastSummary()

    Dim wsData As Worksheet, wsSummary As Worksheet
    Dim selectedMonth As String
    Dim lastRow As Long, summaryRow As Long, dataRow As Long
    Dim cityCol As Integer, summaryCol As Integer
    Dim currentMonth As String
    Dim matchFound As Boolean
    Dim forecastVal As Variant, observationVal As Variant
    Dim result As String
    
    Set wsData = ThisWorkbook.Sheets("ForecastData")
    Set wsSummary = ThisWorkbook.Sheets("Summary")
    
    selectedMonth = Trim(UCase(wsSummary.Range("B1").Value))
    If selectedMonth = "" Then
        MsgBox "Please select a month.", vbExclamation, "No Month Selected"
        Exit Sub
    End If
    
    lastRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Row

    wsSummary.Range("A3:I1000").ClearContents
    wsSummary.Range("A3:I1000").UnMerge
    
    wsSummary.Cells(2, 1).Value = "Date"
    wsSummary.Cells(2, 2).Value = "Type"
    wsSummary.Cells(2, 3).Value = "London"
    wsSummary.Cells(2, 4).Value = "Berlin"
    wsSummary.Cells(2, 5).Value = "Paris"
    wsSummary.Cells(2, 6).Value = "Madrid"
    wsSummary.Cells(2, 7).Value = "Athens"
    wsSummary.Cells(2, 8).Value = "Lisbon"
    wsSummary.Cells(2, 9).Value = "Rome"

    wsSummary.Range("A3:A1000").HorizontalAlignment = xlCenter
    wsSummary.Range("A3:A1000").VerticalAlignment = xlCenter
    
    summaryRow = 3
    matchFound = False
    
    For dataRow = 6 To lastRow Step 2
        If Not IsEmpty(wsData.Cells(dataRow, 2).Value) And IsDate(wsData.Cells(dataRow, 2).Value) Then
            
            currentMonth = Trim(UCase(Format(wsData.Cells(dataRow, 2).Value, "MMMM")))
            
            Debug.Print "Checking Row:", dataRow, "Date:", wsData.Cells(dataRow, 2).Value, "Extracted Month:", currentMonth
            Debug.Print "Selected Month from B1:", selectedMonth
            
            If currentMonth = selectedMonth Then
                wsSummary.Range(wsSummary.Cells(summaryRow, 1), wsSummary.Cells(summaryRow + 1, 1)).Merge
                wsSummary.Cells(summaryRow, 1).Value = wsData.Cells(dataRow, 2).Value
                
                wsSummary.Cells(summaryRow, 2).Value = wsData.Cells(dataRow, 3).Value
                wsSummary.Cells(summaryRow + 1, 2).Value = wsData.Cells(dataRow + 1, 3).Value
                
                summaryCol = 3
                For cityCol = 4 To 10
                    forecastVal = wsData.Cells(dataRow, cityCol).Value
                    observationVal = wsData.Cells(dataRow + 1, cityCol).Value
                    
                    If IsNumeric(forecastVal) And IsNumeric(observationVal) Then
                        If forecastVal = 0 And observationVal = 0 Then
                            result = "H"
                        ElseIf forecastVal = 1 And observationVal = 1 Then
                            result = "H"
                        ElseIf forecastVal = 0 And observationVal = 1 Then
                            result = "M"
                        ElseIf forecastVal = 1 And observationVal = 0 Then
                            result = "FA"
                        Else
                            result = "?"
                        End If
                    Else
                        result = "N/A"
                    End If
                    
                    wsSummary.Range(wsSummary.Cells(summaryRow, summaryCol), wsSummary.Cells(summaryRow + 1, summaryCol)).Merge
                    wsSummary.Cells(summaryRow, summaryCol).Value = result
                    
                    With wsSummary.Range(wsSummary.Cells(summaryRow, summaryCol), wsSummary.Cells(summaryRow + 1, summaryCol))
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Font.Bold = True
                    End With

                    summaryCol = summaryCol + 1
                Next cityCol
                
                summaryRow = summaryRow + 2
                matchFound = True
            End If
        End If
    Next dataRow
    
    If Not matchFound Then
        MsgBox "No matching data for " & selectedMonth & ". Ensure the month exists in Column B.", vbExclamation, "No Data Found"
        Exit Sub
    End If

    MsgBox "Summary table updated for " & selectedMonth, vbInformation, "Update Complete"

End Sub

 

[drefiek2]

Please try this, [Sheet names and ranges should be considered]

Sub ForecastSummary()

    Dim wsData As Worksheet, wsSummary As Worksheet
    Dim selectedMonth As String
    Dim lastRow As Long, summaryRow As Long, dataRow As Long
    Dim cityCol As Integer, summaryCol As Integer
    Dim currentMonth As String
    Dim matchFound As Boolean
    Dim forecastVal As Variant, observationVal As Variant
    Dim result As String
   
    Set wsData = ThisWorkbook.Sheets("ForecastData")
    Set wsSummary = ThisWorkbook.Sheets("Summary")
   
    selectedMonth = Trim(UCase(wsSummary.Range("B1").Value))
    If selectedMonth = "" Then
        MsgBox "Please select a month.", vbExclamation, "No Month Selected"
        Exit Sub
    End If
   
    lastRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Row

    wsSummary.Range("A3:I1000").ClearContents
    wsSummary.Range("A3:I1000").UnMerge
   
    wsSummary.Cells(2, 1).Value = "Date"
    wsSummary.Cells(2, 2).Value = "Type"
    wsSummary.Cells(2, 3).Value = "London"
    wsSummary.Cells(2, 4).Value = "Berlin"
    wsSummary.Cells(2, 5).Value = "Paris"
    wsSummary.Cells(2, 6).Value = "Madrid"
    wsSummary.Cells(2, 7).Value = "Athens"
    wsSummary.Cells(2, 8).Value = "Lisbon"
    wsSummary.Cells(2, 9).Value = "Rome"

    wsSummary.Range("A3:A1000").HorizontalAlignment = xlCenter
    wsSummary.Range("A3:A1000").VerticalAlignment = xlCenter
   
    summaryRow = 3
    matchFound = False
   
    For dataRow = 6 To lastRow Step 2
        If Not IsEmpty(wsData.Cells(dataRow, 2).Value) And IsDate(wsData.Cells(dataRow, 2).Value) Then
           
            currentMonth = Trim(UCase(Format(wsData.Cells(dataRow, 2).Value, "MMMM")))
           
            Debug.Print "Checking Row:", dataRow, "Date:", wsData.Cells(dataRow, 2).Value, "Extracted Month:", currentMonth
            Debug.Print "Selected Month from B1:", selectedMonth
           
            If currentMonth = selectedMonth Then
                wsSummary.Range(wsSummary.Cells(summaryRow, 1), wsSummary.Cells(summaryRow + 1, 1)).Merge
                wsSummary.Cells(summaryRow, 1).Value = wsData.Cells(dataRow, 2).Value
               
                wsSummary.Cells(summaryRow, 2).Value = wsData.Cells(dataRow, 3).Value
                wsSummary.Cells(summaryRow + 1, 2).Value = wsData.Cells(dataRow + 1, 3).Value
               
                summaryCol = 3
                For cityCol = 4 To 10
                    forecastVal = wsData.Cells(dataRow, cityCol).Value
                    observationVal = wsData.Cells(dataRow + 1, cityCol).Value
                   
                    If IsNumeric(forecastVal) And IsNumeric(observationVal) Then
                        If forecastVal = 0 And observationVal = 0 Then
                            result = "H"
                        ElseIf forecastVal = 1 And observationVal = 1 Then
                            result = "H"
                        ElseIf forecastVal = 0 And observationVal = 1 Then
                            result = "M"
                        ElseIf forecastVal = 1 And observationVal = 0 Then
                            result = "FA"
                        Else
                            result = "?"
                        End If
                    Else
                        result = "N/A"
                    End If
                   
                    wsSummary.Range(wsSummary.Cells(summaryRow, summaryCol), wsSummary.Cells(summaryRow + 1, summaryCol)).Merge
                    wsSummary.Cells(summaryRow, summaryCol).Value = result
                   
                    With wsSummary.Range(wsSummary.Cells(summaryRow, summaryCol), wsSummary.Cells(summaryRow + 1, summaryCol))
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Font.Bold = True
                    End With

                    summaryCol = summaryCol + 1
                Next cityCol
               
                summaryRow = summaryRow + 2
                matchFound = True
            End If
        End If
    Next dataRow
   
    If Not matchFound Then
        MsgBox "No matching data for " & selectedMonth & ". Ensure the month exists in Column B.", vbExclamation, "No Data Found"
        Exit Sub
    End If

    MsgBox "Summary table updated for " & selectedMonth, vbInformation, "Update Complete"

End Sub

I tested it and it works when assigned to a button, thanks very much, hugely appreciated!
Is there a way for it to run the code just by selecting the month from a drop down list in B1, rather than pressing a button?

 

[Sam_D_Ben]

Please drop this script in "Summary" sheet like below, {not in module}

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
        If Target.Cells.Count = 1 And Target.Value <> "" Then
            Application.EnableEvents = False
            Call ForecastSummary
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[drefiek2]

Please drop this script in "Summary" sheet like below, {not in module}
View attachment 123057

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
        If Target.Cells.Count = 1 And Target.Value <> "" Then
            Application.EnableEvents = False
            Call ForecastSummary
            Application.EnableEvents = True
        End If
    End If
End Sub

It works, thanks very much!! Huge appreciated.

 

[drefiek2]

Sorry one more question if I may.... if there are any missing values/empty cells in the forecast data table, whether that is Sunny Forecast, Observation, or both cells missing/empty for a particular day, I would like the summary table entry for that day to be empty/blank as well. At the moment it still reports it as a Hit even when blank.

The reason for this is I have a formula at the bottom which calculates the number of H, M and FAs for each city and then do some math based on the number of 'filled in complete' days.

 

[Peter_SSs]

If using your 365 version, would you be interested in a formula approach? Could probably be adapted if you need it to work in your 2021 version as well.
(This is a smaller data size but easily expandable to your full data ranges.)

drefiek2.xlsm
	B	C	D	E	F	G	H	I	J
5	Date	Type	London	Berlin	Paris	Madrid	Athens	Lisbon	Rome
6	1/01/2025	Sunny Forecast	0	0	1	1	0	1	1
7		Observation	1	0	1	0	0	1	1
8	2/01/2025	Sunny Forecast	0	1	0	0	1	0	0
9		Observation	1	1	0	1	1	0	1
10	3/02/2025	Sunny Forecast	1	1	0		1	1	0
11		Observation	1	0			0	0	1
12	4/02/2025	Sunny Forecast	0	0	1	1	0		1
13		Observation	1	0	1	0	0	1	1
14	5/02/2025	Sunny Forecast	0	1	0	0	1	0	0
15		Observation	1	1	0	1	1	0	1
16	3/03/2025	Sunny Forecast	1	1	0	0	1	1	0
17		Observation	1	0	1	1	0	0	1
Sheet1

Cell A1 below would be the month drop-down.

drefiek2.xlsm
	A	B	C	D	E	F	G	H
1	February
2
3		London	Berlin	Paris	Madrid	Athens	Lisbon	Rome
4	3/02/2025	H	FA			FA	FA	M
5	4/02/2025	M	H	H	FA	H		H
6	5/02/2025	M	H	H	M	H	H	M
7
Sheet2

Cell Formulas
Range	Formula
B3:H3	B3	=Sheet1!D5:J5
A4:H6	A4	=LET(b,Sheet1!B6:B17,x,Sheet1!D6:J17,y,IF(x="",2,x),d,TOCOL(IF(b="",1/0,IF(TEXT(b,"mmmm")=A1,b,1/0)),2),q,MATCH(A1,TEXT(b,"mmmm"),0)+SEQUENCE(ROWS(d),,,2),HSTACK(d,IFNA(SWITCH(--(CHOOSEROWS(y,q-1)&CHOOSEROWS(y,q)),0,"H",1,"M",10,"FA",11,"H"),"")))
Dynamic array formulas.

 

[Sam_D_Ben]

Sorry one more question if I may.... if there are any missing values/empty cells in the forecast data table, whether that is Sunny Forecast, Observation, or both cells missing/empty for a particular day, I would like the summary table entry for that day to be empty/blank as well. At the moment it still reports it as a Hit even when blank.

The reason for this is I have a formula at the bottom which calculates the number of H, M and FAs for each city and then do some math based on the number of 'filled in complete' days.

A slight update for that, look for this part of the code and add the blank entry. Please cross check the code in box. {Also you can try the formula above}

If IsEmpty(forecastVal) Or IsEmpty(observationVal) Then
                        result = ""  ' Blank entry
                    
                    ElseIf IsNumeric(forecastVal) And IsNumeric(observationVal) Then
                        If forecastVal = 0 And observationVal = 0 Then
                            result = "H"