[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 205
  • Last Modified:

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
http://www.experts-exchange.com/Microsoft/Applications/Q_26879603.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

0
Petersburg1
Asked:
Petersburg1
  • 2
1 Solution
 
StephenJRCommented:
Bit hard as an interloper, but I notice that you do not assign anything to shts(0, 0).
0
 
Petersburg1Author Commented:
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
0
 
andrewssd3Commented:
Without spending a lot of time looking at exectly what's happening, there are two glaring things: first you start by assigning the value of the variable 'o' to s.  I assume it means '0'. 'o' is not defined and so defaults to zero - this is why I always recommend using Option Explicit.

In any case you don't have a zero dimension in your array as Stephen pointed out, so I'm suggesting starting from 1.  Then you had a gap in the array at element 2, which was causing the loop to quit on the While condition.  So I've changed your array allocation so the next sheet is number 2.  Really you should start using row 0 in the array, or define it differently.  Anyway, see if this works:

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" 'Name of sheet
shts(2, 1) = 2 'Row that holds sum
shts(2, 2) = 2 'start column
shts(2, 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




's = o    ' there is no o - use Option Explicit
s = 1

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

Open in new window

0
 
Petersburg1Author Commented:
Perfect.
It works again
thanks a lot
Nils
0

Featured Post

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now