MACRO TO LOOKUP AND SUM

[K]

ROW A B C D E F--col
1 CODE CO AC FO CR (-) DR (+)
2 1LD M X1 GGG -1000 2000
3 1LD M X1 GGG -2000 4000
4 1LD M X2 SSS -300 500
5 4EN G X2 SSS -4000 8000
6 4EN G X2 SSS -5000 10000
7 4EN S X3 TTT -6000 12000
8 3CO S X3 TTT -7000 14000
9 3CO S X4 SSS -8000 16000
10 3CO S X4 SSS -9000 18000

In Sheet2 I got spreadsheet template setup (see below)


ROW A B C D E F G--
col
1 REF CR CR CR DR DR DR
2 CO-AC-FO 1LD 3CO 4EN 1LD 3CO 4EN


I want macro which should produce result like this in Sheet2 from
Sheet1 (see below). Please if anybody can help


(Shee2)
ROW A B C D E F G--
col
1 REF CR CR CR DR DR DR
2 CO-AC-FO 1LD 3CO 4EN 1LD 3CO 4EN
3 M X1 GGG -3000 6000
4 M X2 SSS -300 500
5 G X2 SSS -9000
18000
6 S X3 TTT -6000
2000
7 S X3 TTT -7000 14000
8 S X4 SSS -17000 34000


basically macro should look in Sheet1 Data and then make result like
above

 

[Mark Ivey]

K,

If you can do the same with this file (upload it for me to review it), I
will see if I can provide a fix for it.

BTW - would you mind taking a minute to rate the results you are getting
from the people that do help you out...

Mark Ivey

 

[Joel]

Sub Collect_Data()

With Sheets("Sheet2")
Set CR = .Range("B22")
Set DR = .Range("E2:G2")
Sh2RowCount = 3
End With
With Sheets("Sheet1")
Sh1RowCount = 2
Do While .Range("A" & Sh1RowCount) <> ""
Code = .Range("A" & Sh1RowCount)
Ref = .Range("B" & Sh1RowCount) & " " & _
.Range("C" & Sh1RowCount) & " " & _
.Range("D" & Sh1RowCount)
CR_Val = .Range("E" & Sh1RowCount)
DR_Val = .Range("F" & Sh1RowCount)
With Sheets("Sheet2")
.Range("A" & Sh2RowCount) = Ref
Set c = CR.Find(what:=Code, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(Sh2RowCount, c.Column) = CR_Val
End If
Set c = DR.Find(what:=Code, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(Sh2RowCount, c.Column) = DR_Val
End If
Sh2RowCount = Sh2RowCount + 1
End With
Sh1RowCount = Sh1RowCount + 1
Loop
End With
End Sub

 

[K]

K,

If you can do the same with this file (upload it for me to review it), I
will see if I can provide a fix for it.

BTW - would you mind taking a minute to rate the results you are getting
from the people that do help you out...

Mark Ivey











- Show quoted text -

sorry Mark i never realised that i can rate someone aswell. i'll do
that from now on. Thanks for the help as joel has solved my prolem. i
must say i am learing quite lot from you all. thank for all knowledge