Sub Reformat_Thermofluor_Data()

' Version 1 - Didster, Sept. 2009
' Version 2 (Substracts reference well) - Didster, Sept. 2009
' Version 4 (fixed bug for deleting blank wells) - Didster, Dec. 2009

minDefault = "25.4"
minTemp = InputBox("Enter minimum temperature for analysis", minDefault, minDefault)

maxDefault = "95.3"
maxTemp = InputBox("Enter maximum temperature for analysis", maxDefault, maxDefault)

stdDefault = "A1"
stdCell = InputBox("Enter well coordinates for reference", stdDefault, stdDefault)

' Copy MultiComponent Data Sheet
ActiveWorkbook.Sheets("MultiComponent Data").Copy after:=ActiveWorkbook.Sheets("MultiComponent Data")
Sheets("MultiComponent Data (2)").Name = "Processed Data"

' Delete superfluous columns and rows
Range("D:D").Delete
Range("B:B").Delete
Range("1:8").Delete

' Transpose data
Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
j = 3
For i = 1 To rng.Row Step 96
Cells(j, "E").Resize(1, 96).Value = _
Application.Transpose(Cells(i, "B").Resize(96, 1))
j = j + 1
Next

' Append data column headings
Cells(2, "D") = "Temp(oC)"
Dim x As Long
Dim y As Long
y = 2
For x = 1 To 1
Cells(y, "E").Resize(1, 96).Value = _
Application.Transpose(Cells(x, "A").Resize(96, 1))
y = y + 1
Next

' Fill temperature series
q = 25.4
For p = 3 To 236
Cells(p, "D") = q
q = q + 0.3
Next

' ***START VERISON 2 CODE***
' Substract "blank" cell from all cells
Dim LstRow As Long, LstCol As Integer, d As Integer, s As Long, firstChar As String

firstChar = Left$(stdCell, 1)
' convert column letter to number
colLett = Asc(firstChar) - 64
colNum = Right(stdCell, Len(stdCell) - 1)
colIdent = (((colLett - 1) * 12) + colNum) + 4

For s = 3 To 236
BLANK = Cells(s, colIdent).Value
For d = 5 To 100
' FIX FOR BLANK CELLS!!! 12/14/09
If Application.CountA(Cells(s, d)) <> 0 Then
WELL = Cells(s, d).Value
Cells(s, d).Value = WELL - BLANK
End If
' END FIX
Next d
Next s
' ***END VERSION 2 CODE***

' Delete empty columns in transposed data
Dim cCount As Integer, col As Integer
cCount = Columns.Count
For col = cCount To 4 Step -1
If Application.CountA(Cells(3, col)) = 0 Then
Columns(col).EntireColumn.Delete
End If
Next col

' Delete data outside temperature range
For cnt = 236 To 3 Step -1
temp = Cells(cnt, "D").Value
If Abs(temp) > Abs(maxTemp) Then
' MsgBox temp & "-" & maxTemp
Rows(cnt).EntireRow.Delete
End If
If Abs(temp) < Abs(minTemp) Then
Rows(cnt).EntireRow.Delete
End If
Next cnt

' Delete columns with original data
Range("A:C").Delete

' Rescale data
Dim LastRow As Long, LastCol As Integer, c As Integer, r As Long
    
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
    
For c = 2 To LastCol
dblMin = Application.Min(Columns(c))
dblMax = Application.Max(Columns(c))
dblRange = dblMax - dblMin
For r = 3 To LastRow
TEST = Cells(r, c).Value
If TEST <> 0 Then
Cells(r, c).Value = (TEST - dblMin) / dblRange
End If
Next r
Next c

' Calculate Tms
Cells(1, "A") = "Tm"

For t = 2 To LastCol
irow = 3
midPoint = 0.5
minny = Abs(Cells(3, t).Value - midPoint)
For i = 3 To 236
temp = Abs(Cells(i, t).Value - midPoint)
If temp < minny Then
minny = temp
irow = i
End If
Next i
Cells(1, t) = (Cells(irow, "A").Value)
Next t

End Sub