Pull data from adjacent and selected row cells based on user inputted date range

[splreece]

MOrning all,

I am sure this is a standard fix but I can only really find formula and vba based on fixed dates and adjacent cells.

I am looking to run reports where my users can dictate a date range

Date from = Cell "L2"
Date to = Cell "M2"

I need to be able to search column "S" for any rows that fall within the date range above and then pull on a new sheet the following columns data:
"k", "h", "ag", "t", "u through to af".

Does this make sense?

any help would be appreciated.

 

[Peter_SSs]

See if this gets you close. I've assumed headings in row 1.
About how many rows of data will you have?

Sub GetDataBetweenDates()
  Dim aData, aResults, aRws, aCols
  Dim rws As Long, cols As Long, lr As Long
  Dim i As Long, j As Long, x As Long, y As Long
  Dim sDate As Long, eDate As Long
  
  aCols = Array(11, 8, 33, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32)
  cols = UBound(aCols) - LBound(aCols) + 1
  ReDim Preserve aCols(1 To cols)
  lr = Range("S" & Rows.Count).End(xlUp).Row
  aRws = Evaluate("Row(2:" & lr & ")")
  aData = Application.Index(Cells, aRws, aCols)
  rws = UBound(aData, 1)
  ReDim aResults(1 To rws, 1 To UBound(aCols) - 1)
  sDate = Range("L2").Value
  eDate = Range("M2").Value
  For i = 1 To rws
    If aData(i, 4) >= sDate Then
      If aData(i, 4) <= eDate Then
        x = x + 1
        y = 0
        For j = 1 To cols
          If j <> 4 Then
            y = y + 1
            aResults(x, y) = aData(i, j)
          End If
        Next j
      End If
    End If
  Next i
  Sheets.Add After:=ActiveSheet
  Range("A2").Resize(x, cols - 1).Value = aResults
End Sub

 

[splreece]

thanks for this.. I am trialling it as we speak (around 1600 lines to filter, but per filter (wkly report) I wouldn't imagine the report be any bigger than 50 -100

 

[splreece]

wow... that is exactly what I needed.

How would I add titles to each of the columns in the new report?

 

[Peter_SSs]

wow... that is exactly what I needed.

Great news!

How would I add titles to each of the columns in the new report?

Try this version.

Sub GetDataBetweenDates()
  Dim aData, aResults, aRws, aCols
  Dim rws As Long, cols As Long, lr As Long
  Dim i As Long, j As Long, x As Long, y As Long
  Dim sDate As Long, eDate As Long
  
  aCols = Array(11, 8, 33, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32)
  cols = UBound(aCols) - LBound(aCols) + 1
  ReDim Preserve aCols(1 To cols)
  lr = Range("S" & Rows.Count).End(xlUp).Row
  aRws = Evaluate("Row(1:" & lr & ")")
  aData = Application.Index(Cells, aRws, aCols)
  rws = UBound(aData, 1)
  ReDim aResults(1 To rws, 1 To UBound(aCols) - 1)
  sDate = Range("L2").Value
  eDate = Range("M2").Value
  For j = 1 To cols
  If j <> 4 Then
    y = y + 1
    aResults(1, y) = aData(1, j)
  End If
  Next j
  x = 1
  For i = 2 To rws
    If aData(i, 4) >= sDate Then
      If aData(i, 4) <= eDate Then
        x = x + 1
        y = 0
        For j = 1 To cols
          If j <> 4 Then
            y = y + 1
            aResults(x, y) = aData(i, j)
          End If
        Next j
      End If
    End If
  Next i
  Sheets.Add After:=ActiveSheet
  Range("A1").Resize(x + 1, cols - 1).Value = aResults
End Sub

 

[Peter_SSs]

.. or by putting the columns in aCols in a better order (19 = col S last), the code simplifies a little to:

Sub GetDataBetweenDates_v2()
  Dim aData, aResults, aRws, aCols
  Dim rws As Long, cols As Long, lr As Long
  Dim i As Long, j As Long, x As Long, y As Long
  Dim sDate As Long, eDate As Long
  
  aCols = Array(11, 8, 33, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 19)
  cols = UBound(aCols) - LBound(aCols) + 1
  ReDim Preserve aCols(1 To cols)
  lr = Range("S" & Rows.Count).End(xlUp).Row
  aRws = Evaluate("Row(1:" & lr & ")")
  aData = Application.Index(Cells, aRws, aCols)
  rws = UBound(aData, 1)
  ReDim aResults(1 To rws, 1 To UBound(aCols) - 1)
  sDate = Range("L2").Value
  eDate = Range("M2").Value
  For j = 1 To cols - 1
    y = y + 1
    aResults(1, y) = aData(1, j)
  Next j
  x = 1
  For i = 2 To rws
    If aData(i, cols) >= sDate Then
      If aData(i, cols) <= eDate Then
        x = x + 1
        y = 0
        For j = 1 To cols - 1
          y = y + 1
          aResults(x, y) = aData(i, j)
        Next j
      End If
    End If
  Next i
  Sheets.Add After:=ActiveSheet
  Range("A1").Resize(x + 1, cols - 1).Value = aResults
End Sub

 

[splreece]

if my data starts at c7 therefore titles are c6. Should I be indicating this in the scripting?

 

[Peter_SSs]

if my data starts at c7 therefore titles are c6. Should I be indicating this in the scripting?

Are the start and end dates still in L2 and M2 or is that now L7 and M7?

 

[splreece]

Date are till L2 & M2

its a header with title/user input on top and main data is presented from c6 (titles)

 

[Peter_SSs]

Date are till L2 & M2

Then just make this one change

aRws = Evaluate("Row(6:" & lr & ")")