Vlookup problem in code

[Les Stout]

Good day all, i am going to try and explain the best i can.
I have a quote on a workbook with 8 sheets which are all named. The
sheet i have to look at to get part numbers looks like this:


"C" "D" "E" "F" "G"
FT E90 FT E90 FT E90 FT E90
6938209 6938210 6938243 6938211
"Two empty rows"

6928614 x x
6930622 x
6930636 x
6930623 x
6930624
6928620 x

I have to start in column "D" at the number, normally row10 but can vary
by 1 or two lines... i than have to look down the column to the first x
and get the number in column "C" in the same row and look it up in
another sheet called "Modules", which looks like this:

"A" "B" "C" "D"

Nr. Modulbezeichnung Sach-Nr. Price
"There is two empty rows here"

1 MD BASIS E87 FT 6928614 34.25
2 MD SPIEGEL LOW OHNE LIN FT 6928615 1.32
3 MD SPIEGEL HIGH MIT LIN FT E87 6928617 5.23
4 MD SPIEGEL L/H M/O LIN FT E87 6930635 1.23
5 MD SPIEGELHEIZUNG FT 6928618
6 MD VORFELDBELEUCHTUNG FT 6928619
7 MD COMFORT ACCESS FT 6928621
8 MD SCHLOSSSCHALTER FT 6938251
9 "Empty Line"

I have to find the same number in column "C" and get the price in column
"D" store it as a variable and do the same with the next x until i get
to the last number, then add the varaibles and put the total in the cell
at the bottom of the column "D" in the first sheet. I then need to move
to the next column and repeat the process until i reach the last number
in row 10. I need some advice and code if possible please.

thanks in advance.

Les Stout

 

[Tom Ogilvy]

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]

The mind boggles !!!!

Thanks Tom

Les Stout

 

[Les Stout]

Hi Tom, now i need to look up another value in the same way, but it must
go into the cell below the one that has just been put in by your code.
Do i just copy your code and look up a different column and then branch
to this code after the first proceedure ? If so then i know how to
change the columns to look for the right value in the Module sheet but I
need to now how to go down one cell below the Tot value that has just
been put in ? I it this proceedure and i must change 0 to 1 ?

Set cell1 = cell1.Offset(cell1.Count, 0)(1)

Thanks

Les Stout

 

[Tom Ogilvy]

Set cell1A = cell1.Offset(cell1.Count+1, 0)(1)

or
Set cell1A = cell1.offset(1,0)

 

[Les Stout]

Couldnt wait so had a look from home, thanks Tom.

Les Stout