Help with code

[Les Stout]

Hi all, Tom Ogilvy very kindly gave me this code and last week it worked
fine !! But this week it is on strike !!

I keep getting the following error:
Object variable or With block variable not set (Error 91)
This happens on the "set range10" line....

Please could someone help me ???

Sub BuildSums()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range, cell As Range
Dim cell2 As Range, col As Range, cell1 As Range
Dim sh As Worksheet, price As Range
Dim rng10 As Range, rng10F As Range
Dim tot As Double, res As Variant
Dim sh1 As Worksheet
Set sh1 = ActiveSheet
If sh1.Name = "Module" Then
MsgBox "Wrong sheet is active"
Exit Sub
End If
Set sh = Worksheets("Module")
Set rng10F = sh.Columns(1).Find(1)
Set rng10 = sh.Range(rng10F, rng10F.End(xlDown)).Offset(0, 2)
Set rng = Columns(1).Find(1)
Set rng = Range(rng, rng.End(xlDown))
Set rng = rng.Offset(0, 2)
Set rng1 = rng.Offset(0, 1).Resize(, 200)
Set rng2 = rng1.SpecialCells(xlConstants, xlTextValues).Columns
Set rng3 = Intersect(rng1.EntireRow, rng2.EntireColumn)
For Each col In rng3.Columns
tot = 0
On Error Resume Next
Set rng4 = col.SpecialCells(xlConstants, xlTextValues)
On Error GoTo 0
If Not rng4 Is Nothing Then
For Each cell In rng4
If Trim(cell.Text) <> "0" Then
Set cell2 = sh1.Cells(cell.Row, rng.Column)
res = Application.Match(cell2.Value, rng10, 0)
If Not IsError(res) Then
tot = tot + rng10(res).Offset(0, 19)
End If
End If
Next
Set cell1 = col.Cells
Set cell1 = cell1.Offset(cell1.Count, 0)(1)
cell1.Value = tot
End If
Next
End Sub


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Dave Peterson]

These two lines work in conjunction with each other:

Set rng10F = sh.Columns(1).Find(1)
Set rng10 = sh.Range(rng10F, rng10F.End(xlDown)).Offset(0, 2)

If the first one fails to find anything, then the second one will fail.

And my bet is that you're being hit by excel's Find command. It remembers the
parameters from the last find command--either manually or via code.

For instance, if you did a Find in excel that looked for something in the
comments, then list line:
Set rng10F = sh.Columns(1).Find(1)

Will be looking in comments.

I'd specify all the parameters that you really want in that .find command:

with sh.Columns(1)
Set rng10F = .Find(What:=1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
end with
'then check to see if anything was found:

if rng10F is nothing then
msgbox "not found"
'what should happen?
exit sub '?????
end if

'continue with other code.

 

[Les Stout]

Thanks dave, will try it out.

best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Tom Ogilvy]

Dave's advice is certainly sound,
Also, if you don't have a 1 in column A (where you numbered your list in the
example file), then it would be problematic.

Also .find("1")

rather than .find(1)
seems more forgiving.

I also provided a solution for putting in your sum formula, but I see you
have posted back looking for a different solution. What was the problem.

 

[Les Stout]

Hi Tom, was just eager to get it going, but would like to see your
solution please.

Thanks again for all the help Dave & Tom.

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Les Stout]

Hi Tom, did you send that code for the totals to my e-mail address ?
Sorry for the time delay.

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Tom Ogilvy]

Several days ago, as soon as I received your question.

From: "Tom Ogilvy" <[email protected]>
To: "STOUT LES" <[email protected]>
References: <[email protected]>
Subject: Re: Code
Date: Fri, 7 Oct 2005 09:16:29 -0400

 

[Tom Ogilvy]

============================

Option Explicit
Sub BuildSums()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range, cell As Range
Dim cell2 As Range, col As Range, cell1 As Range
Dim rng5 as Range, rng6 as Range, rng7 as Range
Dim rng8 as Range
Dim sh As Worksheet, price As Range
Dim rng10 As Range, rng10F As Range
Dim tot As Double, res As Variant
Dim sh1 As Worksheet
' set a reference to the activesheet -
' the sheet with the data to be processed
Set sh1 = ActiveSheet
' if the activesheet is MODULE, jump out
If sh1.Name = "Module" Then
MsgBox "Wrong sheet is active"
Exit Sub
End If
' set a reference to module so we can
' work with it without activating
Set sh = Worksheets("Module")
' find the first row of data in Module by looking
' in column 1 for the number 1
Set rng10F = sh.Columns(1).Find(1)
' find the extent of the data in module by using
' column1. Hold the first cell and do and End(xldown)
' to find the last cell, then offset this range over to
' column C. Now rng10 refers to the column with the numbers
' that will be examined for matches in the data sheet
Set rng10 = sh.Range(rng10F, rng10F.End(xlDown)).Offset(0, 2)
' basically do the same to the active/datasheet
Set rng = Columns(1).Find(1)
Set rng = Range(rng, rng.End(xlDown))
' now we need rng to hold the range of numbers to be looked up. this range
' is in column C of the Active/Datasheet
Set rng = rng.Offset(0, 2)
' now we need to determine the area containing x's since
' you implied it will not always be out to U
Set rng1 = rng.Offset(0, 1).Resize(, 200)
' now rng1 holds the data area from column D for width of
' 200 columns. 200 was an arbitrary number. Wanted to insure
' it contained all columns with an x
Set rng2 = rng1.SpecialCells(xlConstants, xlTextValues).Columns
' rng2 now holds a reference to every cell that contains an x
Set rng3 = Intersect(rng1.EntireRow, rng2.EntireColumn)
' now find row where sums will be placed and cell right of this row
set rng5 = rng3.areas(rng3.areas.count)
set rng6 = range(rng3(1),rng5(rng5.count))
set rng7 = rng6.Offset(rng6.rows.count).Resize(1,rng6.columns.count)
set rng8 = rng7.offset(0,rng7.columns.count)(1)
' rng3 now has been expanded to rectangular areas that are the
' same height as rng (all the numbers to lookup) and it includes
' just columns that contain x's.

' Now I will loop through the columns of rng3 and process each
' column individually
For Each col In rng3.Columns
' zero out the accumulator variable where we will
' accumulate the costs/prices for the column being
' processed
tot = 0
On Error Resume Next
' given the column to process (col), set a reference to
' just the cells in that column that contain an x
' if the column does not contain an x (and there really
' is not way that is possible given what we have done),
' then this command would raise an error, so we protect
' against that and react to it accordingly.
Set rng4 = col.SpecialCells(xlConstants, xlTextValues)
On Error GoTo 0
If Not rng4 Is Nothing Then
' now loop through each cell with an x in the
' column being processed
For Each cell In rng4
' I notices some numbers were zero - while I wouldn't
' expect these rows to have an x, I guard against it
' anyway
If Trim(cell.Text) <> "0" Then
' we are working with the cells with x, so for
' the current cell we are working with, I find
' the corresponding number to be looked up
Set cell2 = sh1.Cells(cell.Row, rng.Column)
' now I match this number to rng10, the numbers
' in the module sheet
res = Application.Match(cell2.Value, rng10, 0)
' the result of the match is held in the variant
' variable res. If it is not found, it will be
' a #N/A, same as in the worksheet. So I check that
' it is not. If it is not, then it holds the offset
' into rng10 where the number was found.
If Not IsError(res) Then
' the number was found, so accumulate the
' the value in Column V as a horizontal offset from
' the cell where we found the match.
tot = tot + rng10(res).Offset(0, 19)
End If
End If
Next
' we are through adding numbers, so find the
' cell in the Activesheet/data sheet where
' we want to display the sum.
Set cell1 = col.Cells
Set cell1 = cell1.Offset(cell1.Count, 0)(1)
' enter the sum in that cell
cell1.Value = tot
End If
Next
rng8 = "=Sum(" & rng7.Address & ")"
' or
' rng8.value = Application.Sum(rng7)
End Sub


=========================