Avatar of Petersburg1
Petersburg1Flag for Russian Federation

asked on 

Find the problem within a received solution

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:R10000C7=RC1)*(MONTH('Data-Import'!R2C3:R10000C3)=R3C),'Data-Import'!R2C5:R10000C5)"
           Case 2
              ActiveCell.FormulaR1C1 = _
                "=SUMPRODUCT(('Data-Import'!R2C7:R10000C7=R2C2)*('Data-Import'!R2C4:R10000C4=RC1)*(MONTH('Data-Import'!R2C3:R10000C3)=R4C),'Data-Import'!R2C5:R10000C5)"
           Case 3
              ActiveCell.FormulaR1C1 = _
                "=SUMPRODUCT(('Data-Import'!R2C4:R10000C4=RC1)*(MONTH('Data-Import'!R2C3:R10000C3)=R4C),'Data-Import'!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

Microsoft ApplicationsMicrosoft Excel

Avatar of undefined
Last Comment
Petersburg1
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image

Bit hard as an interloper, but I notice that you do not assign anything to shts(0, 0).
Avatar of Petersburg1
Petersburg1
Flag of Russian Federation image

ASKER

Hi,
I "played" with that....It was originally 0, 1 and 2....
I thought this does refer to the sheet location? As first sheet is now the data import sheet I thought it might work in this way...
attached the file.

Paper-Usage-Tracking-NIK.xlsm
ASKER CERTIFIED SOLUTION
Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Avatar of Petersburg1
Petersburg1
Flag of Russian Federation image

ASKER

Perfect.
It works again
thanks a lot
Nils
Microsoft Excel
Microsoft Excel

Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.

144K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo