Summary Sheet based on selected date

**pmallick** · 01-12-2015, 11:48 PM

Hello,

I am looking for a way to coalate certain data from all worksheets in my workbook in one summary sheet based on a user inputted date.

The workbook will grow with additional sheets added at irregular intervals.
Each worksheet has the same layout, just with different data.
I want a user to input a date in cell B2.
Then i want the vba to look that value up in all other sheets and copy data from adjacent cells.

I have attached a sample workbook.

Thanks in advance for any help you may be able to provide.

PaulineProject Plans - Sample.xlsm

**karedog** · 01-13-2015, 01:54 AM

Hi,

You can try this code :

Sub GetData()
  Dim strSearch As String, sh As Worksheet, rng As Range, cell As Range
  Dim i As Long, mtx(), ptrMtx As Long

  Sheets("Summary").Select
  strSearch = Format(Range("B2").Value, "DD, MMM")
  ReDim mtx(1 To 3, 1 To 1000)
  ptrMtx = 0

  For Each sh In Worksheets
      If sh.Index <> ActiveSheet.Index Then
         With sh
           Set cell = .Cells.Find(strSearch, LookIn:=xlValues, lookat:=xlPart)
           If Not cell Is Nothing Then
              Set rng = .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp))
              For i = 1 To rng.Rows.Count
                  If (.Cells(rng.Row + i - 1, "B") = "Trade:") And (rng.Cells(i, 1) <> "") Then
                     ptrMtx = ptrMtx + 1
                     mtx(1, ptrMtx) = rng.Cells(i, 1)
                     mtx(2, ptrMtx) = rng.Cells(i + 1, 1)
                     mtx(3, ptrMtx) = rng.Cells(i + 3, 1)
                     i = i + 4
                  End If
              Next i
           End If
         End With
      End If
  Next sh

  Range("C3:E" & Rows.Count).ClearContents
  If ptrMtx = 0 Then
     MsgBox "Nothing found"
     Exit Sub
  Else
     ReDim Preserve mtx(1 To 3, 1 To ptrMtx)
     Range("C3").Resize(UBound(mtx, 2), UBound(mtx, 1)).Value = Application.WorksheetFunction.Transpose(mtx)
  End If
End Sub

Regards