AVERAGE
Sub GenerateBeamHeatmaps()
Dim csvPath As String
Dim csvWB As Workbook
Dim csvWS As Worksheet
Dim mainWB As Workbook
Dim wsOut As Worksheet
Dim lastRow As Long
Dim snrDicts(1 To 3) As Object
Dim r As Long, b As Integer
Dim dateVal As String, heightVal As String
Dim snr(1 To 3) As Variant
Dim dictKey As String
Dim tempArr As Variant
Dim avgVal As Double
csvPath = "C:\Users\Nikolai Petrovsky\OneDrive\Documentos\Coding\915MHz SNR\DRWP2.csv"
Set mainWB = ThisWorkbook
' Open CSV
Workbooks.Open Filename:=csvPath
Set csvWB = ActiveWorkbook
Set csvWS = csvWB.Sheets(1)
' Initialize beam dictionaries
For b = 1 To 3
Set snrDicts(b) = CreateObject("Scripting.Dictionary")
Next b
lastRow = csvWS.Cells(csvWS.Rows.Count, "A").End(xlUp).Row
' Read and process each row, skipping zero‑valued SNRs
For r = 2 To lastRow
dateVal = Trim(csvWS.Cells(r, "A").Value)
heightVal = Trim(csvWS.Cells(r, "D").Value)
snr(1) = csvWS.Cells(r, "Q").Value
snr(2) = csvWS.Cells(r, "R").Value
snr(3) = csvWS.Cells(r, "S").Value
For b = 1 To 3
If IsNumeric(snr(b)) Then
If CDbl(snr(b)) <> 0 Then
dictKey = heightVal & "|" & dateVal
If Not snrDicts(b).Exists(dictKey) Then
snrDicts(b).Add dictKey, Array(CDbl(snr(b)), 1)
Else
tempArr = snrDicts(b)(dictKey)
tempArr(0) = tempArr(0) + CDbl(snr(b))
tempArr(1) = tempArr(1) + 1
snrDicts(b)(dictKey) = tempArr
End If
End If
End If
Next b
Next r
' Names for the three beams
Dim beamNames(1 To 3) As String
beamNames(1) = "Beam1_Heatmap"
beamNames(2) = "Beam2_Heatmap"
beamNames(3) = "Beam3_Heatmap"
Dim beamDict As Object
Dim allHeights As Object, allDates As Object
Dim hKey As Variant, dKey As Variant
Dim heightArr As Variant, dateArr As Variant
Dim rowIdx As Long, colIdx As Long
Dim key As Variant
Dim dataRange As Range
' Loop through beams 1–3
For b = 1 To 3
' Delete old sheet if it exists
On Error Resume Next
mainWB.Sheets(beamNames(b)).Delete
On Error GoTo 0
' Create the new sheet
Set wsOut = mainWB.Sheets.Add
wsOut.Name = beamNames(b)
' Grab this beam's dictionary
Set beamDict = snrDicts(b)
' If there's no data at all, note and skip formatting
If beamDict.Count = 0 Then
wsOut.Range("A1").Value = "No SNR data for " & beamNames(b)
GoTo BeamDone
End If
' Collect unique heights & dates
Set allHeights = CreateObject("Scripting.Dictionary")
Set allDates = CreateObject("Scripting.Dictionary")
For Each key In beamDict.Keys
hKey = Split(key, "|")(0)
dKey = Split(key, "|")(1)
allHeights(hKey) = 1
allDates(dKey) = 1
Next key
heightArr = allHeights.Keys
dateArr = allDates.Keys
' Sort height DESC, date ASC
Call QuickSort(heightArr, LBound(heightArr), UBound(heightArr), True)
Call QuickSort(dateArr, LBound(dateArr), UBound(dateArr), False)
' Write header row of dates
For colIdx = 0 To UBound(dateArr)
wsOut.Cells(1, colIdx + 2).Value = dateArr(colIdx)
Next colIdx
' Fill the grid: heights down, dates across
For rowIdx = 0 To UBound(heightArr)
wsOut.Cells(rowIdx + 2, 1).Value = heightArr(rowIdx)
For colIdx = 0 To UBound(dateArr)
dictKey = heightArr(rowIdx) & "|" & dateArr(colIdx)
If beamDict.Exists(dictKey) Then
tempArr = beamDict(dictKey)
avgVal = tempArr(0) / tempArr(1)
If avgVal <> 0 Then
wsOut.Cells(rowIdx + 2, colIdx + 2).Value = Int(avgVal)
Else
wsOut.Cells(rowIdx + 2, colIdx + 2).Value = ""
End If
Else
wsOut.Cells(rowIdx + 2, colIdx + 2).Value = ""
End If
Next colIdx
Next rowIdx
' Apply 3‑color scale over the data range
Set dataRange = wsOut.Range( _
wsOut.Cells(2, 2), _
wsOut.Cells(UBound(heightArr) + 2, UBound(dateArr) + 2) _
)
With dataRange.FormatConditions.AddColorScale(ColorScaleType:=3)
.ColorScaleCriteria(1).Type = xlConditionValueLowestValue
.ColorScaleCriteria(1).FormatColor.Color = RGB(0, 0, 255)
.ColorScaleCriteria(2).Type = xlConditionValuePercentile
.ColorScaleCriteria(2).Value = 50
.ColorScaleCriteria(2).FormatColor.Color = RGB(255, 255, 0)
.ColorScaleCriteria(3).Type = xlConditionValueHighestValue
.ColorScaleCriteria(3).FormatColor.Color = RGB(255, 0, 0)
End With
dataRange.NumberFormat = "0"
wsOut.Columns.AutoFit
BeamDone:
Next b
csvWB.Close SaveChanges:=False
MsgBox "Heatmap tables created for Beam 1, 2, and 3!", vbInformation
End Sub
' QuickSort helper
Sub QuickSort(arr As Variant, ByVal first As Long, ByVal last As Long, Optional descending As Boolean = False)
Dim low As Long, high As Long
Dim pivot As Variant, tmp As Variant
low = first: high = last
pivot = arr((first + last) \ 2)
Do While low <= high
If descending Then
Do While arr(low) > pivot: low = low + 1: Loop
Do While arr(high) < pivot: high = high - 1: Loop
Else
Do While arr(low) < pivot: low = low + 1: Loop
Do While arr(high) > pivot: high = high - 1: Loop
End If
If low <= high Then
tmp = arr(low)
arr(low) = arr(high)
arr(high) = tmp
low = low + 1
high = high - 1
End If
Loop
If first < high Then QuickSort arr, first, high, descending
If low < last Then QuickSort arr, low, last, descending
End Sub