Bit hard as an interloper, but I notice that you do not assign anything to shts(0, 0).

Solved

Posted on 2011-10-05

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

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-exchang

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

Case 2

ActiveCell.FormulaR1C1 = _

"=SUMPRODUCT(('Data-Import

Case 3

ActiveCell.FormulaR1C1 = _

"=SUMPRODUCT(('Data-Import

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

4 Comments

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

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
```

Title | # Comments | Views | Activity |
---|---|---|---|

copying from excel to word | 2 | 30 | |

MS Access Form Control Background Color Change Depending On How Long The String Text Length Is | 18 | 37 | |

How to Autofill Across to next value | 3 | 21 | |

Microsoft Access 2010 Question | 2 | 14 |

Join the community of 500,000 technology professionals and ask your questions.

Connect with top rated Experts

**23** Experts available now in Live!