Match and extract based on horizontal and vertical criteria between 2 dates

[Silverstone]

FOR EXPERTS

Hello everyone.

As this is my first post on this platform as I got stuck after days of trying without success and I apologize if already exist the same post because I couldn't find it.

Namely, I have a excel table that consist of horizontal dates (of 2-3 years) and vertical data where is recorded style name, production line and qty produced per day.
I need to create monthly report that shows by date (now in vertical) which styles are produced in specific dates and qty per that style. Here below screen shoot how looks like the table in small, It would be highly appreciated when anyone solve this.

Name (this is in B2)	Line	01-jan​	02-jan​	03-jan​	04-jan​	05-jan​
Amelie	Line 1	200​
Faye	Line 1	100​
Amelie	Line 2	600​	100​
Nelle	Line 2		300​
Faye	Line 1		400​
Gordon	Line 3			300​
Start date	01-jan​
End Date	30-jan​
Exctract dates	Exctract name	Exctract Line	Exctract qty
01-jan​	Amelie	Line 1	200​
01-jan​	Faye	Line 1	100​
01-jan​	Amelie	Line 2	600​
02-jan​	Amelie	Line 2	100​
02-jan​	Nelle	Line 2	300​
02-jan​	Faye	Line 1	400​
03-jan​	Gordon	Line 1	300​

 

[DanteAmor]

Hi & welcome to MrExcel.

Try the following macro. The data must be on sheet 1, the results will be on sheet 2, from row 6 down.

Put the start and end dates on sheet2 in cells C2 and C3:

Dante Amor
	A	B	C	D	E
1
2		start date	01/02/2021
3		end date	28/02/2021
4
5		Extract dates	Extract name	Extract Line	Extract qty
Sheet2

You can adjust the input and output data in these lines of the macro:

  Set sh1 = Sheets("Sheet1")  'fits the name of the source sheet
  Set sh2 = Sheets("Sheet2")  'fits the name of the dstination sheet
  Set cell = sh1.Range("B2")  'fits the cell where the data starts
  Set f = cell.EntireRow.Find(sh2.Range("C2").Value, , xlFormulas, xlWhole, , xlNext)
    Set f = cell.EntireRow.Find(sh2.Range("C3").Value, , xlFormulas, xlWhole, , xlNext)
      sh2.Range("B6").Resize(k, 4).Value = b

Sub Extract_Data()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
  Dim c1 As Long, c2 As Long, x As Long, y As Long
  Dim cell As Range, f As Range
  Dim a As Variant, b As Variant
  
  Set sh1 = Sheets("Sheet1")  'fits the name of the source sheet
  Set sh2 = Sheets("Sheet2")  'fits the name of the dstination sheet
  Set cell = sh1.Range("B2")  'fits the cell where the data starts
  sh2.Rows("6:" & Rows.Count).ClearContents
                              'fits the cell where is the start date
  Set f = cell.EntireRow.Find(sh2.Range("C2").Value, , xlFormulas, xlWhole, , xlNext)
  If Not f Is Nothing Then
    c1 = f.Column
                              'fits the cell where is the end date
    Set f = cell.EntireRow.Find(sh2.Range("C3").Value, , xlFormulas, xlWhole, , xlNext)
    If Not f Is Nothing Then
      c2 = f.Column
      
      x = cell.Row
      y = cell.Column
      lr = sh1.Cells(Rows.Count, y).End(3).Row
      lc = sh1.Cells(x, Columns.Count).End(1).Column
      
      a = sh1.Range("A1", sh1.Cells(lr, lc)).Value
      ReDim b(1 To (c2 - c1) + 1 * UBound(a, 2), 1 To 4)
      For j = c1 To c2
        For i = x + 1 To UBound(a, 1)
          If a(i, j) <> "" Then
            k = k + 1
            b(k, 1) = a(x, j)     'date
            b(k, 2) = a(i, y)     'name
            b(k, 3) = a(i, y + 1) 'line
            b(k, 4) = a(i, j)     'qty
          End If
        Next
      Next
      sh2.Range("B6").Resize(k, 4).Value = b
    Else
      MsgBox "The end date does not exist"
    End If
  Else
    MsgBox "The start date does not exist"
  End If
End Sub

________________________
HOW TO INSTALL MACROs
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (Extract_Data) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[Silverstone]

Hi & welcome to MrExcel.

Try the following macro. The data must be on sheet 1, the results will be on sheet 2, from row 6 down.

Put the start and end dates on sheet2 in cells C2 and C3:

Dante Amor
	A	B	C	D	E
1
2		start date	01/02/2021
3		end date	28/02/2021
4
5		Extract dates	Extract name	Extract Line	Extract qty
Sheet2

You can adjust the input and output data in these lines of the macro:

  Set sh1 = Sheets("Sheet1")  'fits the name of the source sheet
  Set sh2 = Sheets("Sheet2")  'fits the name of the dstination sheet
  Set cell = sh1.Range("B2")  'fits the cell where the data starts
  Set f = cell.EntireRow.Find(sh2.Range("C2").Value, , xlFormulas, xlWhole, , xlNext)
    Set f = cell.EntireRow.Find(sh2.Range("C3").Value, , xlFormulas, xlWhole, , xlNext)
      sh2.Range("B6").Resize(k, 4).Value = b

Sub Extract_Data()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
  Dim c1 As Long, c2 As Long, x As Long, y As Long
  Dim cell As Range, f As Range
  Dim a As Variant, b As Variant
 
  Set sh1 = Sheets("Sheet1")  'fits the name of the source sheet
  Set sh2 = Sheets("Sheet2")  'fits the name of the dstination sheet
  Set cell = sh1.Range("B2")  'fits the cell where the data starts
  sh2.Rows("6:" & Rows.Count).ClearContents
                              'fits the cell where is the start date
  Set f = cell.EntireRow.Find(sh2.Range("C2").Value, , xlFormulas, xlWhole, , xlNext)
  If Not f Is Nothing Then
    c1 = f.Column
                              'fits the cell where is the end date
    Set f = cell.EntireRow.Find(sh2.Range("C3").Value, , xlFormulas, xlWhole, , xlNext)
    If Not f Is Nothing Then
      c2 = f.Column
     
      x = cell.Row
      y = cell.Column
      lr = sh1.Cells(Rows.Count, y).End(3).Row
      lc = sh1.Cells(x, Columns.Count).End(1).Column
     
      a = sh1.Range("A1", sh1.Cells(lr, lc)).Value
      ReDim b(1 To (c2 - c1) + 1 * UBound(a, 2), 1 To 4)
      For j = c1 To c2
        For i = x + 1 To UBound(a, 1)
          If a(i, j) <> "" Then
            k = k + 1
            b(k, 1) = a(x, j)     'date
            b(k, 2) = a(i, y)     'name
            b(k, 3) = a(i, y + 1) 'line
            b(k, 4) = a(i, j)     'qty
          End If
        Next
      Next
      sh2.Range("B6").Resize(k, 4).Value = b
    Else
      MsgBox "The end date does not exist"
    End If
  Else
    MsgBox "The start date does not exist"
  End If
End Sub

________________________
HOW TO INSTALL MACROs
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (Extract_Data) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Thank you so much, it is exactly what I needed, except I thought it would be more easier formula that I can apply to my actual workbook and problem is that my excel sheet with data is more complicated than example I posted and I found difficult now to modify VBA code in order to extract data. Please check photo attached.

This because I have 30 columns before date range starts, so that Order # is in column/cell H5 which I have to add to the extraction , Style name is in column/cell I5, Line in column/cell R5 and dates starts from column/cell AE3 while data to be sum in are from AE5. In between these columns are other columns that contains other data as well. It would be great when you can solve this for me and add in the VBA code some more comments that I can understand and modify in future without bothering you again.