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
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