Formula in cells missing after running VBA Macro - vba

Question

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

Answer 1

There are a few main points I just want to make about your code that should help.
Avoid using .Select
Always explicitly state the sheet (and workbook, if applicable) when using multiple worksheets. This can cause many headaches if you don't, especially if using .Select and are bouncing around sheets copying/pasting. This may be a reason your PasteSpecial is overwriting data you want - you don't specify the sheet it should paste over.
Use Option Explicit at the top, to force you to declare all variables.
The way you are declaring variables isn't doing what you think it is.
I'll start with Point 4 first. You're doing
Dim i, j, k, obs, n As Integer - I assume you wish to have i, j, k, etc. as Integers. Only n is being declared as an integer...the others are the default (Variant). For each variable, you need to explicitly tell VBA what type you want. So, use Dim i as Integer, j as Integer, k as Integer, etc. In my code, you'll see I'm doing Dim i&, j&, the & is shorthand for As Integer. (See this page for a few more, such as # for As Double)
Point 3 - I'm not sure where the ValuePos variable is set, so that may cause an issue with your pasting. This is where Option Explicit helps you make sure you have the variables you are trying to use.
The first and second points are contained in my code. I tried to leave your code as-is, but comment out lines you don't need, and also added a few comments of my own.
The main concern I have is that I'm not sure what sheets each range you need, so look closely and adjust as necessary.
Option Explicit
Sub ReadData()
Dim i&, j&, k&, obs&, n&
Dim value#, sum#
Dim resultsExist As Boolean
' I think you want these as ranges, but change if not.
Dim maxObserv As Range, ValuePos As Range, findColumn As Range, defaultPos As Range
Dim powerWS As Worksheet, dataWS As Worksheet, analysisWS As Worksheet, resultsWS As Worksheet
Dim infoPos As Range
Set powerWS = Sheets("Power")
Set dataWS = Sheets("Data")
Set analysisWS = Sheets("Analysis")
Set resultsWS = Sheets("Results")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = "Read Data: Copying data"
' Copy factor values
powerWS.Range("IData").Resize(maxObserv).Clear
'Sheets("Data").Select ' You don't need to use `.select`, you can just work directly with the data. Plus, you never do anything with this selection
' Rows("1:1").Select
i = findColumn(dataWS, Range("Name").value)
'If i = 0 Then GoTo Cleanup 'Don't use GoTo, not best practice. Instead just do the following
If i = 0 Then
Application.CutCopyMode = False
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
'Cells(1, i).Select
'ActiveCell.Range("A2:A" & maxObserv).Select
'Application.CutCopyMode = False
'Selection.Copy ' This can be replaced with the below, to avoid using .Select
' I don't know which sheet you wanted, so change the `powerWS` to whatever sheet it should be
powerWS.Cells(1, i).Copy
powerWS.Range(ValuePos).PasteSpecial xlPasteValues ' WHERE DOES ValuePos come from???
Application.CutCopyMode = False
' Copy default data
'Sheets("Data").Select
'Range("A2:A" & maxObserv).Select
'Selection.Copy
dataWS.Range("A2:A" & maxObserv).Copy
powerWS.Range(defaultPos).Paste
Application.CutCopyMode = False
' Copy segment data
j = findColumn(dataWS, "ID")
If j > 0 Then
With dataWS
.Range(.Cells(1, j), .Cells(maxObserv, j + 3)).Copy ' Change here to adjust sample size
End With
'Sheets("Power").Select
powerWS.Range(infoPos).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
' Sort data
Application.StatusBar = "Read Data: Sorting"
'Sheets("Power").Select
'Range("IData").Select
powerWS.Range("IData").Sort Key1:=powerWS.Range(ValuePos), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
obs = 1
value = -9999999
Do Until powerWS.Cells(obs + 4, 2) = ""
With powerWS
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
End With
Loop
' Retrieve or calculate buckets range
'Sheets("Analysis").Selecth
With analysisWS
k = findColumn(resultsWS, resultsWS.Range("Name").value) ' What sheet is "Name" on, I assumed the "Results" sheet
If (k > 0) Then resultsExist = (resultsWS.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
End With
Calculate
'Cleanup:
Application.CutCopyMode = False
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I hope this helps get to the bottom of it. If not, I still recommend trying to break down the removal of .Select and using the explicit sheet names/ranges. But again, if this is the only code you're using, ValuePos is empty, so when you go to paste to that range, there's ...no range? You should add some declaration for that variable.
Edit: As #vacip mentions, you can step through the macro with F8 and watch what each line does. Especially pay attention when you get to the PasteSpecial lines. It'll allow you to see where the pasting is being done, so you can tweak accordingly.