Attribute VB_Name = "CombineTemperatureSensors"
Option Explicit

Public Sub BuildCombinedTemperatureSheet()
    Const SUMMARY_SHEET As String = "Combined Data"
    Const TIME_HEADER As String = "Local Time"
    Const TEMPERATURE_HEADER As String = "Temperature"

    Dim sourceBook As Workbook
    Dim sourceSheet As Worksheet
    Dim summarySheet As Worksheet
    Dim readingsBySensor As Collection
    Dim sensorNames As Collection
    Dim commonTimes As Object
    Dim sensorReadings As Object
    Dim timeCell As Range
    Dim temperatureCell As Range
    Dim lastRow As Long
    Dim dataRow As Long
    Dim sensorCount As Long
    Dim timeKey As String
    Dim key As Variant
    Dim keysSnapshot As Variant
    Dim outputData() As Variant
    Dim outputRow As Long
    Dim outputColumn As Long
    Dim lastOutputRow As Long
    Dim lastOutputColumn As Long
    Dim oldCalculation As XlCalculation
    Dim readingPair As Variant

    Set sourceBook = ActiveWorkbook
    Set readingsBySensor = New Collection
    Set sensorNames = New Collection
    Set commonTimes = CreateObject("Scripting.Dictionary")
    commonTimes.CompareMode = vbTextCompare

    oldCalculation = Application.Calculation
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    On Error GoTo CleanFail

    For Each sourceSheet In sourceBook.Worksheets
        If StrComp(sourceSheet.Name, SUMMARY_SHEET, vbTextCompare) <> 0 Then
            Set timeCell = FindHeading(sourceSheet, TIME_HEADER)
            Set temperatureCell = FindHeading(sourceSheet, TEMPERATURE_HEADER)

            If Not timeCell Is Nothing And Not temperatureCell Is Nothing Then
                If timeCell.Row = temperatureCell.Row Then
                    Set sensorReadings = CreateObject("Scripting.Dictionary")
                    sensorReadings.CompareMode = vbTextCompare

                    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, timeCell.Column).End(xlUp).Row

                    For dataRow = timeCell.Row + 1 To lastRow
                        If Len(Trim$(CStr(sourceSheet.Cells(dataRow, timeCell.Column).Value2))) > 0 Then
                            timeKey = TimestampKey(sourceSheet.Cells(dataRow, timeCell.Column).Value2)

                            If Len(timeKey) > 0 Then
                                sensorReadings(timeKey) = Array( _
                                    sourceSheet.Cells(dataRow, timeCell.Column).Value, _
                                    sourceSheet.Cells(dataRow, temperatureCell.Column).Value)
                            End If
                        End If
                    Next dataRow

                    If sensorReadings.Count > 0 Then
                        sensorCount = sensorCount + 1
                        readingsBySensor.Add sensorReadings
                        sensorNames.Add sourceSheet.Name

                        If sensorCount = 1 Then
                            For Each key In sensorReadings.Keys
                                commonTimes.Add CStr(key), True
                            Next key
                        Else
                            keysSnapshot = commonTimes.Keys
                            For Each key In keysSnapshot
                                If Not sensorReadings.Exists(CStr(key)) Then
                                    commonTimes.Remove CStr(key)
                                End If
                            Next key
                        End If
                    End If
                End If
            End If
        End If
    Next sourceSheet

    If sensorCount < 2 Then
        MsgBox "At least two sheets containing matching '" & TIME_HEADER & _
               "' and '" & TEMPERATURE_HEADER & "' headings are required.", _
               vbExclamation, "Combine temperature sensors"
        GoTo CleanExit
    End If

    If commonTimes.Count = 0 Then
        MsgBox "No timestamps occur on every detected sensor sheet.", _
               vbExclamation, "Combine temperature sensors"
        GoTo CleanExit
    End If

    Application.DisplayAlerts = False
    On Error Resume Next
    sourceBook.Worksheets(SUMMARY_SHEET).Delete
    On Error GoTo CleanFail
    Application.DisplayAlerts = True

    Set summarySheet = sourceBook.Worksheets.Add(After:=sourceBook.Worksheets(sourceBook.Worksheets.Count))
    summarySheet.Name = SUMMARY_SHEET

    lastOutputColumn = sensorCount + 1
    lastOutputRow = commonTimes.Count + 4

    With summarySheet.Range(summarySheet.Cells(1, 1), summarySheet.Cells(1, lastOutputColumn))
        .Merge
        .Value = "Combined Temperature Data"
        .Interior.Color = RGB(31, 78, 120)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
        .Font.Size = 16
        .RowHeight = 28
    End With

    With summarySheet.Range(summarySheet.Cells(2, 1), summarySheet.Cells(2, lastOutputColumn))
        .Merge
        .Value = "Exact timestamp matches only. This combined sheet changes the workbook and is not covered by the original document verification."
        .Interior.Color = RGB(217, 234, 247)
        .Font.Color = RGB(51, 65, 85)
        .Font.Italic = True
        .WrapText = True
        .RowHeight = 32
    End With

    summarySheet.Cells(4, 1).Value = TIME_HEADER
    For outputColumn = 1 To sensorCount
        summarySheet.Cells(4, outputColumn + 1).Value = sensorNames(outputColumn)
    Next outputColumn

    ReDim outputData(1 To commonTimes.Count, 1 To lastOutputColumn)
    outputRow = 0

    For Each key In commonTimes.Keys
        outputRow = outputRow + 1
        Set sensorReadings = readingsBySensor(1)
        readingPair = sensorReadings(CStr(key))
        outputData(outputRow, 1) = readingPair(0)

        For outputColumn = 1 To sensorCount
            Set sensorReadings = readingsBySensor(outputColumn)
            readingPair = sensorReadings(CStr(key))
            outputData(outputRow, outputColumn + 1) = readingPair(1)
        Next outputColumn
    Next key

    summarySheet.Range(summarySheet.Cells(5, 1), _
                       summarySheet.Cells(lastOutputRow, lastOutputColumn)).Value = outputData

    With summarySheet.Range(summarySheet.Cells(4, 1), summarySheet.Cells(4, lastOutputColumn))
        .Interior.Color = RGB(91, 155, 213)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With

    summarySheet.Range(summarySheet.Cells(5, 1), summarySheet.Cells(lastOutputRow, 1)).NumberFormat = "yyyy-mm-dd hh:mm:ss"
    summarySheet.Range(summarySheet.Cells(5, 2), summarySheet.Cells(lastOutputRow, lastOutputColumn)).NumberFormat = "0.00"
    summarySheet.Columns(1).ColumnWidth = 21
    summarySheet.Range(summarySheet.Columns(2), summarySheet.Columns(lastOutputColumn)).ColumnWidth = 21

    With summarySheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=summarySheet.Range(summarySheet.Cells(5, 1), summarySheet.Cells(lastOutputRow, 1)), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange summarySheet.Range(summarySheet.Cells(4, 1), summarySheet.Cells(lastOutputRow, lastOutputColumn))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With

    summarySheet.ListObjects.Add( _
        SourceType:=xlSrcRange, _
        Source:=summarySheet.Range(summarySheet.Cells(4, 1), summarySheet.Cells(lastOutputRow, lastOutputColumn)), _
        XlListObjectHasHeaders:=xlYes).Name = "CombinedTemperatureTable"

    summarySheet.Activate
    ActiveWindow.FreezePanes = False
    summarySheet.Range("B5").Select
    ActiveWindow.FreezePanes = True
    summarySheet.Range("A1").Select

    MsgBox Format$(commonTimes.Count, "#,##0") & " exact timestamp matches were combined across " & _
           sensorCount & " sensor sheets.", vbInformation, "Combine temperature sensors"

CleanExit:
    Application.DisplayAlerts = True
    Application.Calculation = oldCalculation
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub

CleanFail:
    Application.DisplayAlerts = True
    Application.Calculation = oldCalculation
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "The combined sheet could not be created:" & vbCrLf & vbCrLf & _
           Err.Description, vbCritical, "Combine temperature sensors"
End Sub

Private Function FindHeading(ByVal targetSheet As Worksheet, ByVal headingText As String) As Range
    Dim foundCell As Range

    Set foundCell = targetSheet.Cells.Find( _
        What:=headingText, _
        After:=targetSheet.Cells(targetSheet.Rows.Count, targetSheet.Columns.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)

    Set FindHeading = foundCell
End Function

Private Function TimestampKey(ByVal timestampValue As Variant) As String
    If IsError(timestampValue) Or IsEmpty(timestampValue) Then
        TimestampKey = vbNullString
    ElseIf IsNumeric(timestampValue) Then
        TimestampKey = "N|" & Format$(CDbl(timestampValue), "0.0000000000")
    Else
        TimestampKey = "T|" & Trim$(CStr(timestampValue))
    End If
End Function