Beginner VBA question

[hutch27]

I have an "orders" and "results" worksheet and am having trouble with the code.

The "Orders" worksheet contains the info about order date, customer identification & order amount. Since customers ordered more than once, there are multiple entries of customer IDs. My task is to write a sub that finds those customers whose total order amount is greater than $1500, and show these customers' IDs and corresponding total order amount in the "results" worksheet, and also sort the results by total amount in ascending order. <tbody> </tbody>

<tbody>
</tbody>

Sub Subtotal()


Dim Amountpurchased As Single
Dim CustomerID As Integer
Dim x As Integer
Dim ResultRow As Integer


With Sheet2.Range("A3:C549")
ResultRow = 0
x = 1
For CustomerID = 101 To 199
Amountpurchased = 0
Do While CustomerID = .Offset(x, 1).Value
Amountpurchased = Amountpurchased + .Offset(x, 2)
x = x + 1
Loop

If Amountpurchased > 1500 Then
ResultRow = ResultRow + 1
With Sheet3.Range("A1:B101")
.Offset(ResultRow, 0).Value = CustomerID
.Offset(ResultRow, 1).Value = Amountpurchased
End With
End If
Next CustomerID

End With
With Sheet3
.Range("A1:B101").Sort KEY1:=Range("B1:B101"), Order1:=xlAscending, Header:=xlYes
End With


End Sub

 

[thatoneguy650]

My Orders sheet

Customer ID	Order Amount
1	$2,257
2	$1,578
3	$2,419
4	$414
5	$2,674
6	$448
7	$100
3	$1,348
4	$2,604
2	$1,588
5	$1,877
6	$1,255
3	$695
7	$1,241
6	$2,626
5	$438
3	$1,998
2	$2,508
8	$1,051

<tbody>
</tbody>

The Results Sheet

Customer ID	Subtotal
3	$6,460
2	$5,674
5	$4,989
6	$4,329
4	$3,018
1	$2,257

<tbody>
</tbody>

Code

Sub mrExcelSubtotal()

Lastrow = Sheets("Orders").UsedRange.Rows.Count


Sheets("Orders").Range("A1:A" & Lastrow).Copy


With Sheets("Results")
    .Range("A1").PasteSpecial Paste:=xlPasteValues
    .Activate
    .Range("B1").Select
    .Range(Range("A1"), Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes
    .Cells(1, 2).Value = "Subtotal"
End With


For i = 2 To ActiveSheet.UsedRange.Rows.Count
    Cells(i, 2).Value = Application.WorksheetFunction.SumIf(Sheets("Orders").Range("A:A"), "=" & Cells(i, 1).Value, Sheets("Orders").Range("B:B"))
Next


For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
    If Cells(i, 2).Value < 1500 Then
        Cells(i, 2).EntireRow.Delete
    End If
Next


Sheets("Results").Range("A1:B" & ActiveSheet.UsedRange.Rows.Count).Sort KEY1:=Range("B1:B" & ActiveSheet.UsedRange.Rows.Count), Order1:=xlDescending, Header:=xlYes


End Sub

 

[hutch27]

Something is wrong when applying it to mine and I'm looking at your code to try and figure it out. There's two things that aren't working: 1) the order ID's arent matching & 2) the amounts arent matching, too. In your "orders" worksheet do you have three columns like in this picture of minE


SORRY THE PICTURE IS UPSIDE DOWN I BLAME TINYPIC AND IPHONE PORTRAIT LOCK

 

[thatoneguy650]

I changed my Orders sheet to look like yours.

Customer Orders
Order Date	Customer ID	Amount Purchased
2-Jan-05	144	$1,611
2-Jan-05	190	$650
3-Jan-05	120	$1,487
3-Jan-05	145	$880
3-Jan-05	188	$1,226
3-Jan-05	192	$575
4-Jan-05	105	$1,650
4-Jan-05	111	$939
4-Jan-05	113	$1,370

<tbody>
</tbody>

Here is the output

Customer ID	Subtotal
144	1611
105	1650

<tbody>
</tbody>

and changed code

Sub mrExcelSubtotal()


Lastrow = Sheets("Orders").UsedRange.Rows.Count




Sheets("Orders").Range("B3:B" & Lastrow).Copy




With Sheets("Results")
    .Range("A1").PasteSpecial Paste:=xlPasteValues
    .Activate
    .Range("B1").Select
    .Range(Range("A1"), Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes
    .Cells(1, 2).Value = "Subtotal"
End With




For i = 2 To ActiveSheet.UsedRange.Rows.Count
    Cells(i, 2).Value = Application.WorksheetFunction.SumIf(Sheets("Orders").Range("B:B"), "=" & Cells(i, 1).Value, Sheets("Orders").Range("C:C"))
Next




For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
    If Cells(i, 2).Value < 1500 Then
        Cells(i, 2).EntireRow.Delete
    End If
Next




Sheets("Results").Range("A1:B" & ActiveSheet.UsedRange.Rows.Count).Sort KEY1:=Range("B1:B" & ActiveSheet.UsedRange.Rows.Count), Order1:=xlAscending, Header:=xlYes




End Sub