VBA Copy rows on to same sheet depending on variables

[pscofe]

Hi, looking to copy and paste an entire row to the bottom of a table if criteria has been met.
Example:
If Currency is NOT 'USD, EUR or GBP' then copy that row to a few cells below the existing table. Is this possible? Thanks

local_acc_no	closing_balance	currency	stmt_date	FEED_TYPE
AA	- 1,064,238.50	USD	15/01/2020 00:00​	Stmt Ccy Message
BB	- 95,237.29	EUR	15/01/2020 00:00	Stmt Ccy Message
CC	- 42,370.41	EUR	15/01/2020 00:00	Stmt Ccy Message
DD	- 26,220.93	EUR	15/01/2020 00:00	Stmt Ccy Message
EE	- 10,923.28	CNY	15/01/2020 00:00	Stmt Ccy Message
FF	- 6,740.20	USD	15/01/2020 00:00	Stmt Ccy Message
HH	- 2,364.93	EUR	15/01/2020 00:00	Stmt Ccy Message
II	- 0.02	EUR	15/01/2020 00:00	Stmt Ccy Message
JJ	- 0.01	USD	15/01/2020 00:00	Stmt Ccy Message

 

[Kamolga]

I would do something like

Dim dCell as Range
Dim rng as Range: Set rng=Range("C2:C99") 'you can set 99 as dynamic last row or column of a table

For each dCell in rng
   If (dCell<>"USD" and dCell<>"EUR" and dCell<>"GPB") then
      dcell.entirerow.copy
     dcell.offset(100,0).paste                       '100 rows below, you can set up a dynamic variable
  End if
Next dCell

 

[DanteAmor]

Hi pscofe, welcome to MrExcel!

Here another macro for you to consider:

Sub Copy_rows()
  Dim i As Long
  For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
    Select Case Range("C" & i).Value
      Case "USD", "EUR", "GBP"
      Case Else
        Rows(i).Copy Range("A" & Range("C" & Rows.Count).End(xlUp)(2).Row)
    End Select
  Next
End Sub

 

[pscofe]

Thanks both, much appreciated.

 

[pscofe]

Is it possible to copy those lines and remove them from existing table?
So BEFORE table:

local_acc_no	closing_balance	currency	stmt_date	FEED_TYPE
AA	- 1,064,238.50	USD	15/01/2020 00:00	Stmt Ccy Message
BB	- 95,237.29	EUR	15/01/2020 00:00	Stmt Ccy Message
CC	- 42,370.41	EUR	15/01/2020 00:00	Stmt Ccy Message
DD	- 26,220.93	EUR	15/01/2020 00:00	Stmt Ccy Message
EE	- 10,923.28	CNY	15/01/2020 00:00	Stmt Ccy Message
FF	- 6,740.20	USD	15/01/2020 00:00	Stmt Ccy Message
GG	- 2,364.93	EUR	15/01/2020 00:00	Stmt Ccy Message
HH	- 0.02	EUR	15/01/2020 00:00	Stmt Ccy Message
II	- 0.01	USD	15/01/2020 00:00	Stmt Ccy Message

 

[pscofe]

END table:

local_acc_no	closing_balance	currency	stmt_date	FEED_TYPE
AA	- 1,064,238.50	USD	15/01/2020 00:00	Stmt Ccy Message
BB	- 95,237.29	EUR	15/01/2020 00:00	Stmt Ccy Message
CC	- 42,370.41	EUR	15/01/2020 00:00	Stmt Ccy Message
DD	- 26,220.93	EUR	15/01/2020 00:00	Stmt Ccy Message
FF	- 6,740.20	USD	15/01/2020 00:00	Stmt Ccy Message
GG	- 2,364.93	EUR	15/01/2020 00:00	Stmt Ccy Message
HH	- 0.02	EUR	15/01/2020 00:00	Stmt Ccy Message
II	- 0.01	USD	15/01/2020 00:00	Stmt Ccy Message
local_acc_no	closing_balance	currency	stmt_date	FEED_TYPE
EE	- 10,923.28	CNY	15/01/2020 00:00	Stmt Ccy Message

 

[DanteAmor]

Try this

Sub Copy_rows()
  Dim i As Long, lr As Long
  Application.ScreenUpdating = False
  lr = Range("C" & Rows.Count).End(xlUp).Row
  Rows(1).Copy Rows(lr + 2)
  For i = lr To 2 Step -1
    Select Case Range("C" & i).Value
      Case "USD", "EUR", "GBP"
      Case Else
        Rows(i).Copy Range("A" & Range("C" & Rows.Count).End(xlUp)(2).Row)
        Rows(i).Delete
    End Select
  Next
End Sub

 

[pscofe]

that's brilliant, works perfectly! Thanks

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.