In the 'power' sheet under the column D,E & F there were formulas written in the cells; however, after running the following macro (I think), the aforementioned formulas vanished. How did this happen? And how can I retain the original formulas while running the macro?
Sub ReadData()
Dim i, j, k, obs, n As Integer
Dim value, sum As Double
Dim resultsExist As Boolean
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = "Read Data: Copying data"
' Copy factor values
Sheets("Power").Range("IData").Resize(maxObserv).Clear
Sheets("Data").Select
Rows("1:1").Select
i = FindColumn(Sheets("Data"), Range("Name").value)
If i = 0 Then GoTo Cleanup
Cells(1, i).Select
ActiveCell.Range("A2:A" & maxObserv).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Power").Select
Range(ValuePos).PasteSpecial xlPasteValues
Application.CutCopyMode = False
' Copy default data
Sheets("Data").Select
Range("A2:A" & maxObserv).Select
Selection.Copy
Sheets("Power").Select
Range(DefaultPos).Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Copy segment data
Sheets("Data").Select
j = FindColumn(Sheets("Data"), "ID")
If j > 0 Then
ActiveSheet.Range(Cells(1, j), Cells(maxObserv, j + 3)).Select ' Change here to adjust sample size
Selection.Copy
Sheets("Power").Select
Range(InfoPos).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
' Sort data
Application.StatusBar = "Read Data: Sorting"
Sheets("Power").Select
Range("IData").Select
Selection.Sort Key1:=Range(ValuePos), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
obs = 1
value = -9999999
Do Until Cells(obs + 4, 2) = ""
If Cells(obs + 4, 1) <> value Then
If (n > 1) And (sum > 0) Then
For k = obs - n To obs - 1
Cells(k + 4, 2) = sum / n
Next k
End If
n = 1
value = Cells(obs + 4, 1)
sum = Cells(obs + 4, 2)
Else
n = n + 1
sum = sum + Cells(obs + 4, 2)
End If
obs = obs + 1
Loop
' Retrieve or calculate buckets range
Sheets("Analysis").Select
k = FindColumn(Sheets("Results"), Range("Name").value)
If (k > 0) Then resultsExist = (Sheets("Results").Cells(6, k) <> "") Else resultsExist = False
If resultsExist Then
Application.StatusBar = "Read Data: Retrieving stored results"
Range("loBucket") = Sheets("Results").Cells(11, k)
Range("hiBucket") = Sheets("Results").Cells(12, k)
Range("upperCutoff") = 2.95 / Sheets("Results").Cells(7, k) + Sheets("Results").Cells(6, k)
Range("lowerCutoff") = 2 * Sheets("Results").Cells(6, k) - Range("upperCutoff")
Else
Application.StatusBar = "Read Data: Calculating suggestions"
Calculate
Range("loBucket") = Range("minData") ' Alternatively one could set this
Range("hiBucket") = Range("maxData") ' to 5% and 95% percentile
Range("lowerCutoff") = Application.WorksheetFunction.Percentile(Range("Data"), 0.05)
Range("upperCutoff") = Application.WorksheetFunction.Percentile(Range("Data"), 0.95)
End If
Calculate
Cleanup:
Application.CutCopyMode = False
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
New edit: sorry I've left out the option explicit part of the code, it's like this -
Option Explicit
Const maxObserv As Integer = 30000
Const ValuePos As String = "A5"
Const DefaultPos As String = "B5"
Const InfoPos As String = "C4"
New edit: FindColumn is a function defined as below -
Function FindColumn(searchSheet As Worksheet, colName As String) As Integer
Dim i As Integer
i = 2
Do While searchSheet.Cells(1, i) <> ""
If searchSheet.Cells(1, i) = colName Then
FindColumn = i
Exit Do
End If
i = i + 1
Loop
End Function
New edit: below are the codes run before the aforementioned codes under sub "ReadData()", which might affect the result -
Sub AdjustModel()
Dim obs As Integer
Dim tmpRange As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' Count number of observations in Data sheet
Sheets("Data").Select
obs = 1
Do Until Cells(1 + obs, 1) = "" And Cells(2 + obs, 1) = ""
obs = obs + 1
Loop
' Adjust names to required length
ActiveWorkbook.Names("Data").RefersTo = "=Power!$A$5:$A$" & (5 + obs) ' factor values
ActiveWorkbook.Names("DData").RefersTo = "=Power!$B$5:$B$" & (5 + obs) ' default flag
ActiveWorkbook.Names("LData").RefersTo = "=Scores!$A$5:$A$" & (5 + obs) ' logit values
ActiveWorkbook.Names("SData").RefersTo = "=Scores!$B$5:$B$" & (5 + obs) ' factor scores
ActiveWorkbook.Names("PData").RefersTo = "=Power!$T$5:$V$" & (5 + obs) ' data for power calculation
ActiveWorkbook.Names("IData").RefersTo = "=Power!$A$5:$F$" & (5 + obs) ' information data
Sheets("Power").Names("BData").RefersTo = "=Power!$G$5:$G$" & (5 + obs) ' bucket number of observation
Sheets("Scores").Names("BData").RefersTo = "=Scores!$C$5:$C$" & (5 + obs) ' bucket number of observation
'Adjust formulas to correct length
Sheets("Power").Range("PData").Formula = Sheets("Power").Range("PData").Rows(1).Formula
Sheets("Power").Range("BData").Formula = Sheets("Power").Range("BData").Cells(1, 1).Formula
Sheets("Scores").Range("BData").Formula = Sheets("Scores").Range("BData").Cells(1, 1).Formula
Sheets("Scores").Range("LData").Formula = Sheets("Scores").Range("LData").Cells(1, 1).Formula
Sheets("Scores").Range("SData").Formula = Sheets("Scores").Range("SData").Cells(1, 1).Formula
' Adjust charts
Sheets("Analysis").ChartObjects("Chart 1").Chart.SeriesCollection(1).XValues = Range("PData").Columns(1)
Sheets("Analysis").ChartObjects("Chart 1").Chart.SeriesCollection(1).Values = Range("PData").Columns(2)
' Cleanup
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub