Skip to main content

I have a problem regarding VBA

  • May 17, 2017
  • 3 replies
  • 0 views
D

I have 2 worksheets

ID      Amount

A            50

B            60

C            10  

A            10  <== Sheet1

 

what im trying to do is to filter the sheet1, which is all amount greater than 50 will be copy to sheet2 the problem is if A is already in sheet2 all A should be in sheets2 regarding their amount

Here's my code

Sub Test()
Dim john As Variant
Dim r As Range
Dim JCena As Range
Dim JLo As Range

Set JCena = Sheets("Sheet1").Range("A2:A110")
Set JLo = Sheets("Sheet2").Range("A2:A110")


For Each Cell In Sheets(1).Range("B:B")

If Cell.Value >= 50 Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
If JLo.Value = JCena.Value Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
Next


End Sub


#Rumba

3 replies

D

I have 2 worksheets

ID      Amount

A            50

B            60

C            10  

A            10  <== Sheet1

 

what im trying to do is to filter the sheet1, which is all amount greater than 50 will be copy to sheet2 the problem is if A is already in sheet2 all A should be in sheets2 regarding their amount

Here's my code

Sub Test()
Dim john As Variant
Dim r As Range
Dim JCena As Range
Dim JLo As Range

Set JCena = Sheets("Sheet1").Range("A2:A110")
Set JLo = Sheets("Sheet2").Range("A2:A110")


For Each Cell In Sheets(1).Range("B:B")

If Cell.Value >= 50 Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
If JLo.Value = JCena.Value Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
Next


End Sub


#Rumba
Hi Dumskie,

I'm not 100% sure I understand your issue. I think I do, but not sure. Let me try and rephrase the issue and propose what I would do.

Scenario: I have a spreadsheet with a list of transactions. Two columns, Customer ID and Amount (of say $). Any individual Customer ID may appear multiple times in the spreadsheet.

Problem: I need to note all Customer ID's which have transacted more than $50 in total (i.e. maybe in 3 or 4 transactions).

What I would do here is process the Spreadsheet twice, one the first run I would
a) add an index column the the row number.
b) sort the data (including the index column) by Customer ID.
c) calculate the total amount for each user and note any which have a total of >$50.
d) Sort the data by the index column and clear the index column (basically reverse the earlier sort, so that the data appears in the same sequence it did before I started my routine).

At this point we have a list of the individual Customer ID's which have a total of >$50

On the second run I would
a) Check the Customer ID on each row, if it's in my list then I write that row to Sheet2
b) If it's not in my list then go to the next row.

Does that make sense? If you are looking at a different problem, then apologies. Maybe you could outline it again.

Tom
D

I have 2 worksheets

ID      Amount

A            50

B            60

C            10  

A            10  <== Sheet1

 

what im trying to do is to filter the sheet1, which is all amount greater than 50 will be copy to sheet2 the problem is if A is already in sheet2 all A should be in sheets2 regarding their amount

Here's my code

Sub Test()
Dim john As Variant
Dim r As Range
Dim JCena As Range
Dim JLo As Range

Set JCena = Sheets("Sheet1").Range("A2:A110")
Set JLo = Sheets("Sheet2").Range("A2:A110")


For Each Cell In Sheets(1).Range("B:B")

If Cell.Value >= 50 Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
If JLo.Value = JCena.Value Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
Next


End Sub


#Rumba
That's my problem Tom and i cant figure out what logic should i use.
D

I have 2 worksheets

ID      Amount

A            50

B            60

C            10  

A            10  <== Sheet1

 

what im trying to do is to filter the sheet1, which is all amount greater than 50 will be copy to sheet2 the problem is if A is already in sheet2 all A should be in sheets2 regarding their amount

Here's my code

Sub Test()
Dim john As Variant
Dim r As Range
Dim JCena As Range
Dim JLo As Range

Set JCena = Sheets("Sheet1").Range("A2:A110")
Set JLo = Sheets("Sheet2").Range("A2:A110")


For Each Cell In Sheets(1).Range("B:B")

If Cell.Value >= 50 Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
If JLo.Value = JCena.Value Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End If
Next


End Sub


#Rumba

Hi dumskie,

hopefully this will give you enough to go on.

Tom

'Sheet1 sample data as (1,1)

          

Sub forDumskie()
    Sheet1.Activate
    'Get LastRow and Column
    lastColumn% = Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Column
    lastrow% = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

    'Inserting an Index Column
    Sheet1.Range("A1").EntireColumn.Insert

    'Insert the Keys
    For I = 1 To lastrow
      Sheet1.Cells(I, "A") = I
    Next I

    'Sort the data
    Range("A1:C" & lastrow).Sort key1:=Range("B1:B" & lastrow), order1:=xlAscending, Header:=xlNo

    'Generate a list of Customers with Transaction totals > 49
    'First Transaction
    CustomerTotal = Sheet1.Cells(1, "C")

    'Rest of the Transactions
    For I = 1 To lastrow
      If Sheet1.Cells(I, "B") = Sheet1.Cells(I 1, "B") Then
        CustomerTotal = CustomerTotal Sheet1.Cells(I 1, "C")
      Else
        If CustomerTotal > 49 Then
          MyCustomerList = MyCustomerList & Sheet1.Cells(I, "B") & ","
        End If
        CustomerTotal = Sheet1.Cells(I 1, "C")
      End If
    Next I
    MsgBox MyCustomerList

    'Copy the relevant cells to Sheet2
    For I = 1 To lastrow
      If InStr(1, MyCustomerList, Sheet1.Cells(I, "B") & ",") Then
        Sheet2.Cells(I, "A") = Sheet1.Cells(I, "B")
        Sheet2.Cells(I, "B") = Sheet1.Cells(I, "C")
      End If
    Next I

    'Undo the earlier sort
    Range("A1:C" & lastrow).Sort key1:=Range("A1:A" & lastrow), order1:=xlAscending, Header:=xlNo

    'Remove the Index column
    Sheet1.Range("A1").EntireColumn.Delete

    'Sort Sheet2 transactions.
    lastColumn% = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column
    lastrow% = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
    Sheet2.Range("A1:B" & lastrow).Sort key1:=Sheet2.Range("A1:A" & lastrow), order1:=xlAscending, Header:=xlNo

    'Activate Sheet2
    Sheet2.Activate
End Sub

Recent badge winners

Explore all badges
Terms & ConditionsAccessibility statement