PDA

View Full Version : Solved: Lookup Column A value and add Column X- then copy to other sheet



Anomandaris
11-12-2009, 02:53 AM
I need a code that looks through Column A (account numbers) then adds up the profit from Column X for each account number. The total profit for each account is then sent to different sheets. Account 100 profit sent to Sheet ‘S1’, Account 200 profit to Sheet ‘S2’, and so on…….The profit figure will go to Column C (Sheets S1,S2,S3..), in the next empty cell.

If started the code using Select Case method but I don’t know how to do the adding part…….




Public Sub Summary()
Dim wsSource As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wsOutput As Worksheet
Dim rngCell As Range, rngData As Range
Dim NextRw As Long
On Error GoTo ExitPoint
Set wsSource = Sheets("Summary")
Set ws1 = Sheets("S1")
Set ws2 = Sheets("S2")
Set ws3 = Sheets("S3")


With wsSource
Set rngData = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
End With

For Each rngCell In rngData.SpecialCells(xlCellTypeConstants, xlNumbers)

Select Case rngCell.Offset(, -2)
Case 100: Set wsOutput = ws1
Case 200: Set wsOutput = ws2
Case 300: Set wsOutput = ws3

End Select
Set wsOutput = Nothing
Next rngCell
ExitPoint:
Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing

Set wsSource = Nothing
End Sub




I have shown in the file the desired answer on S1, i need similar result on S2 and S3 as well

Anomandaris
11-12-2009, 02:55 AM
I typed that in a rush, so if its unclear please let me know, Thanks

Bob Phillips
11-12-2009, 03:03 AM
Untested



Public Sub Summary()
Dim wsSource As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wsOutput As Workshee
Dim rngAccount As Range, rngProfit As Range
On Error GoTo ExitPoint
Set wsSource = Sheets("Summary")
Set ws1 = Sheets("S1")
Set ws2 = Sheets("S2")
Set ws3 = Sheets("S3")

With wsSource
Set rngAccount = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).Offset(0, -2)
Set rngProfit = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).Offset(0, 21)
End With

ws1.Range("C1").End(ws1.Rows.Count, "C").End(xlUp).Offset(1, 0).Formula = _
"=SUMIF(Summary!" & rngAccount.Address & ",100,Summary!" & rngProfit.Address & ")"
ws2.Range("C1").End(ws2.Rows.Count, "C").End(xlUp).Offset(1, 0).Formula = _
"=SUMIF(Summary!" & rngAccount.Address & ",200,Summary!" & rngProfit.Address & ")"
ws3.Range("C1").End(ws3.Rows.Count, "C").End(xlUp).Offset(1, 0).Formula = _
"=SUMIF(Summary!" & rngAccount.Address & ",300,Summary!" & rngProfit.Address & ")"

ExitPoint:
Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing

Set wsSource = Nothing
End Sub

Anomandaris
11-12-2009, 04:01 AM
Thanks xld but It gives an error on the 'End' statement........

Compile error
wrong number of arguments or invalid preperty assignment

Bob Phillips
11-12-2009, 04:31 AM
See if this is better



Public Sub Summary()
Dim wsSource As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wsOutput As Worksheet
Dim rngAccount As Range, rngProfit As Range
On Error GoTo ExitPoint
Set wsSource = Sheets("Summary")
Set ws1 = Sheets("S1")
Set ws2 = Sheets("S2")
Set ws3 = Sheets("S3")

With wsSource
Set rngAccount = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).Offset(0, -2)
Set rngProfit = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).Offset(0, 21)
End With

ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Offset(1, 0).Formula = _
"=SUMIF(Summary!" & rngAccount.Address & ",100,Summary!" & rngProfit.Address & ")"
ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Offset(1, 0).Formula = _
"=SUMIF(Summary!" & rngAccount.Address & ",200,Summary!" & rngProfit.Address & ")"
ws3.Cells(ws3.Rows.Count, "C").End(xlUp).Offset(1, 0).Formula = _
"=SUMIF(Summary!" & rngAccount.Address & ",300,Summary!" & rngProfit.Address & ")"

ExitPoint:
Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing

Set wsSource = Nothing
End Sub

Anomandaris
11-12-2009, 06:07 AM
Fantastic xld! works great