Dear Experts, Dear Zwiekhorst:,
I received a solution from you which worked quite well but now only for one sheet but not for another....
Asking for anybody's help to fix it and to help me to understand what went wrong
https://www.experts-exchange.com/questions/26879603/Freeze-the-results-in-a-table-with-a-formula.html
In your solution the data sheet was the last sheet....now the data sheet is the first one. The Printer Report is the second sheet, the Person & Printer comes next but does not need any value freezing and the Person sheet comes next but does NOT work. Meaning it does not freeze the values upon closing. When I open data is lost as the formula is still active.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call valpst
End Sub
Private Sub Workbook_Open()
Call clrrng
End Sub
Sub valpst()
Dim i, j, s As Integer
Dim totl As Variant
Dim shts(10, 4) As Variant
shts(1, 0) = "Printer-Report" 'Name of sheet
shts(1, 1) = 4 'Row that holds sum
shts(1, 2) = 2 'start column
shts(1, 3) = 13 'end column
'shts(2, 0) = "Person & Printer" 'Name of sheet
'shts(2, 1) = 5 'Row that holds sum
'shts(2, 2) = 2 'start column
'shts(2, 3) = 13 'end column
shts(3, 0) = "Person" 'Name of sheet
shts(3, 1) = 2 'Row that holds sum
shts(3, 2) = 2 'start column
shts(3, 3) = 13 'end column
s = o
While shts(s, 0) > ""
Sheets(shts(s, 0)).Select
For i = shts(s, 2) To shts(s, 3) 'loop thru columns
totl = Cells(shts(s, 1), i).FormulaR1C1
If Cells(shts(s, 1), i) > 0 Then
j = shts(s, 1) + 1 'start one row below sum
While Cells(j, i) > "" 'loop until column A hold blanks
Cells(j, i) = Cells(j, i).Value
j = j + 1
Wend
Else
If totl = 0 Then 'check if sum was zero'd
j = shts(s, 1) + 1 'start one row below sum
While Cells(j, i) > ""
Cells(j, i).Select
Select Case s
Case 1
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT(('Data-Import
'!R2C7:R10
000C7=RC1)
*(MONTH('D
ata-Import
'!R2C3:R10
000C3)=R3C
),'Data-Im
port'!R2C5
:R10000C5)
"
Case 2
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT(('Data-Import
'!R2C7:R10
000C7=R2C2
)*('Data-I
mport'!R2C
4:R10000C4
=RC1)*(MON
TH('Data-I
mport'!R2C
3:R10000C3
)=R4C),'Da
ta-Import'
!R2C5:R100
00C5)"
Case 3
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT(('Data-Import
'!R2C4:R10
000C4=RC1)
*(MONTH('D
ata-Import
'!R2C3:R10
000C3)=R4C
),'Data-Im
port'!R2C5
:R10000C5)
"
End Select
j = j + 1
Wend
Cells(shts(s, 1), i).FormulaR1C1 = "=SUM(R[1]C:R[" & j & "]C)" 'reset sum to formula
End If
End If
Next
s = s + 1
Wend
i = i
End Sub