Selective copying based on criteria

[default_name]

Hi guys!

I have kind of a complex question.
It all starts with a very large spreadsheet (let's call it 'raw data'). It has many columns of information (A:GD).
Much of this data is pretty useless to me, to be honest.
But there are a few pieces of information that I want to extract (if the row meets a certain criteria) onto a new sheet (let's call it 'reduced data').
The criteria is date (found in column AR).

If the date in column AR comes after 'today's date minus two years' [example: today is May 21, 2020. if the date is after May 21, 2018] then I want to grab relevant data from certain columns in that row and paste it into the new sheet.

Fictional Data Example:

The following represents the 'raw data' table (including some unwanted data). I skipped a few columns (shown with the '....') just to show the scale of the data.
The raw data table also changes/varies in number of rows from time to time.
If I have this data, then I would want to look at the cell in column AR. If the date comes after 'today's date minus two years' then I want to copy over desired data from that row.
If it comes before that date, then the data is ignored and the VBA moves on to check the next row.

A	B	C	....	AR	AS	...	GB	GC	GD
213467544	8-898-5641	Y	....​	2/21/2005	QGC	....​	UPLA	5451388	Blue
404138435	7-8243-863	Y	....​	5/15/2019	QRP	....​	USLS	1545348	Blue
513545431	9-999-5621	X	....​	8/8/2023	QGC	....​	UPLC	1534688	Green
451354513	55-43354-4	Y	....​	5/14/2020	QPA	....​	URST	6435412	Red
451345454	66-4548-87	X	....​	5/18/2018	QHU	....​	UGJR	1513334	Red
451567378	48-000-264	C	....​	6/20/2024	JGKS	....​	UJGL	1324858	Green

The following represents the new 'reduced data' sheet where the important data is pasted.
Notice how data from only a few rows were copied over.
Also notice that the data was copied over in a particular column order.

A (copied from GD)	B (copied from AS)	C (copied from AR)	D (copied from A)
Blue	QRP	5/15/2019	404138435
Green	QGC	8/8/2023	513545431
Red	QPA	5/14/2020	451354513
Green	JGKS	6/20/2024	451567378

I am hoping to achieve this routine via VBA code. I am having issues, though, because the table length (number of rows) can vary/change too.
I hope this makes sense.

 

[DanteAmor]

Try this:

Sub ReducedData()
  Dim a As Variant, b As Variant, nDate As Date
  Dim i As Long, j As Long
  
  a = Sheets("raw data").Range("A2:GD" & Sheets("raw data").Range("AR" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a), 1 To 4)
  nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
  For i = 1 To UBound(a)
    If a(i, 44) > nDate Then
      j = j + 1
      b(j, 1) = a(i, 186)
      b(j, 2) = a(i, 45)
      b(j, 3) = a(i, 44)
      b(j, 4) = a(i, 1)
    End If
  Next
  Sheets("reduced data").Range("A2").Resize(j, 4).Value = b
End Sub

 

[default_name]

You
Are
A
Wizard!!

Thank you! This works perfectly!

 

[DanteAmor]

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

 

[default_name]

I want to incorporate the routine with multiple raw data sheets.

Basically, I want to paste into the same 'reduced data' sheet (there is a 'raw data2' sheet in the same workbook, with similar information).
How would I run the same type of routine on 'raw data2' but to have the VBA paste that data after/at the end/bottom of the original 'raw data' information?

Here is my attempt, but it doesn't really work.

Sub ReducedData()
Dim a As Variant, b As Variant, nDate As Date
Dim i As Long, j As Long

a = Sheets("raw data").Range("A2:GD" & Sheets("raw data").Range("AR" & Rows.Count).End(3).Row).Value2
ReDim c(1 To UBound(a), 1 To 4)
nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
For i = 1 To UBound(a)
If a(i, 44) > nDate Then
j = j + 1
c(j, 1) = a(i, 186)
c(j, 2) = a(i, 45)
c(j, 3) = a(i, 44)
c(j, 4) = a(i, 1)
End If
Next
Sheets("reduced data").Range("A2").Resize(j, 4).Value =c

b = Sheets("raw data2").Range("A2:GD" & Sheets("raw data2").Range("AR" & Rows.Count).End(3).Row).Value2
ReDim c(1 To UBound(a), 1 To 4)
nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
For i = 1 To UBound(a)
If a(i, 44) > nDate Then
j = (j + 1)
c(j, 1) = a(i, 186)
c(j, 2) = a(i, 45)
c(j, 3) = a(i, 44)
c(j, 4) = a(i, 1)
End If
Next
Sheets("reduced data").Range.End(xlUp).Row("A2").Resize(j, 4).Value = c

End Sub

Thanks again for all your help!

 

[DanteAmor]

Here you can put the raw sheets:
shs = Array("raw data", "raw data2")


Try this:

Sub ReducedData()
  Dim a As Variant, b As Variant, nDate As Date
  Dim i As Long, j As Long, shs As Variant, s As Variant
  Dim sh As Worksheet
  
  Set sh = Sheets("reduced data")
  shs = Array("raw data", "raw data2")
  sh.Rows("2:" & Rows.Count).ClearContents
  For s = 0 To UBound(shs)
    j = 1
    a = Sheets(shs(s)).Range("A2:GD" & Sheets(shs(s)).Range("AR" & Rows.Count).End(3).Row).Value2
    ReDim b(1 To UBound(a), 1 To 4)
    nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
    For i = 1 To UBound(a)
      If a(i, 44) > nDate Then
        b(j, 1) = a(i, 186)
        b(j, 2) = a(i, 45)
        b(j, 3) = a(i, 44)
        b(j, 4) = a(i, 1)
        j = j + 1
      End If
    Next
    sh.Range("A" & Rows.Count).End(3)(2).Resize(j, 4).Value = b
    Erase a, b
  Next
End Sub

 

[default_name]

Hey Dante,

Thanks for your help and patience on this! I really do appreciate it!

Your code works just as I mentioned it. The problem is, I erred in my most recent comment.
Both raw data sheets have similar information, yes.
But both of the spreadsheets have the data organized in different columns.

I just realized that as I was trying to implement your most recent code. My previous post should have looked like this:
The column numbers in each of the routines needed to be different:

c(j, 1) = a(i, 186)
c(j, 2) = a(i, 45)
c(j, 3) = a(i, 44)
c(j, 4) = a(i, 1)
for pulling from raw data

and

c(j, 1) = a(i, 18)
c(j, 2) = a(i, 38)
c(j, 3) = a(i, 40)
c(j, 4) = a(i, 42)
for pulling from raw data2

Sub ReducedData()
Dim a As Variant, b As Variant, nDate As Date
Dim i As Long, j As Long

a = Sheets("raw data").Range("A2:GD" & Sheets("raw data").Range("AR" & Rows.Count).End(3).Row).Value2
ReDim c(1 To UBound(a), 1 To 4)
nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
For i = 1 To UBound(a)
If a(i, 44) > nDate Then
j = j + 1
c(j, 1) = a(i, 186)
c(j, 2) = a(i, 45)
c(j, 3) = a(i, 44)
c(j, 4) = a(i, 1)
End If
Next
Sheets("reduced data").Range("A2").Resize(j, 4).Value =c

b = Sheets("raw data2").Range("A2:GD" & Sheets("raw data2").Range("AR" & Rows.Count).End(3).Row).Value2
ReDim c(1 To UBound(a), 1 To 4)
nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
For i = 1 To UBound(a)
If a(i, 44) > nDate Then
j = (j + 1)
c(j, 1) = a(i, 18)
c(j, 2) = a(i, 38)
c(j, 3) = a(i, 40)
c(j, 4) = a(i, 42)
End If
Next
Sheets("reduced data").Range.End(xlUp).Row("A2").Resize(j, 4).Value = c

End Sub

Thanks again for your help. You are the best!

 

[DanteAmor]

If a(i, 44) > nDate Then
j = (j + 1)
c(j, 1) = a(i, 18)
c(j, 2) = a(i, 38)
c(j, 3) = a(i, 40)
c(j, 4) = a(i, 42)
for pulling from raw data2

In rawdata2 in which column do you have the date?

 

[default_name]

In rawdata2 in which column do you have the date?

It is in column AN (column #40)

 

[DanteAmor]

In that case:

Sub ReducedData()
  Dim a As Variant, nDate As Date
  Dim i As Long, j As Long, lr As Long
  Dim sh As Worksheet
  
  nDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
  Set sh = Sheets("reduced data")
  sh.Rows("2:" & Rows.Count).ClearContents
  
  a = Sheets("raw data").Range("A2:GD" & Sheets("raw data").Range("AR" & Rows.Count).End(3).Row).Value2
  ReDim c(1 To UBound(a), 1 To 4)
  For i = 1 To UBound(a)
    If a(i, 44) > nDate Then
      j = j + 1
      c(j, 1) = a(i, 186)
      c(j, 2) = a(i, 45)
      c(j, 3) = a(i, 44)
      c(j, 4) = a(i, 1)
    End If
  Next
  sh.Range("A2").Resize(j, 4).Value = c
  
  j = 0
  Erase a, c
  a = Sheets("raw data2").Range("A2:GD" & Sheets("raw data2").Range("AR" & Rows.Count).End(3).Row).Value2
  ReDim c(1 To UBound(a), 1 To 4)
  For i = 1 To UBound(a)
    If a(i, 40) > nDate Then
      j = j + 1
      c(j, 1) = a(i, 18)
      c(j, 2) = a(i, 38)
      c(j, 3) = a(i, 40)
      c(j, 4) = a(i, 42)
    End If
  Next
  
  lr = sh.Range("C" & Rows.Count).End(3).Row + 1
  sh.Range("A" & lr).Resize(j, 4).Value = c
End Sub