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

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


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


"Tom Ogilvy" wrote in message
...
Several days ago, as soon as I received your question.

From: "Tom Ogilvy"
To: "STOUT LES"
References: <9660E7893E8F5F48B909D4D4E6788F1C012F1E99@haf0exc1 1.w9
Subject: Code
Date: Fri, 7 Oct 2005 09:16:29 -0400

--
Regards,
Tom Ogilvy


"Les Stout" wrote in message
...
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 ***