Excel Extracting Dates

[JAMhome]

Hi

I have a summary sheet with many records. I want to be able to extract records based on certain dates from the summary into another worksheet. Is there any code that will do this automatically? Hope this is enough information.

 

[JAMhome]

Hi Damon

User feedback will be the death of me. The pop-up box is great but it is always going to be column 3 for the dates. How do I code that in?

Can the code only produce the worksheet one time? For example, if the user executes the code again it produces another worksheet tab. Once again I need help with altering the code.

I have code for getting totals but I cannot get it to work correctly. If I could figure out how to get the results of extracting dates to appear in row b4 for headings and b5 for first row of data I think this code would work. Here is the code:

Next ws
Worksheets("Summary").Activate
Sheets("Summary").Move After:=Sheets("Cover")
Worksheets("Summary").Cells.Select
Columns("A:C").EntireColumn.AutoFit
r = Range("C" & Rows.count).End(xlUp).Row + 2
Cells(r, 5) = "": Cells(r, 5).NumberFormat = "[$$-409]#,##0.00;[Red][$$-409]#,##0.00"
Cells(r, 6) = ""
Cells(r, 7) = "": Cells(r, 7).NumberFormat = "[$$-409]#,##0.00;[Red][$$-409]#,##0.00"
Cells(r, 3) = "": Cells(r, 3) = ((r - 2) - 4)
For a = 5 To r - 2
Cells(r, 5) = Cells(r, 5) + Cells(a, 5)
Cells(r, 6) = Cells(r, 6) + Cells(a, 6)
Cells(r, 7) = Cells(r, 7) + Cells(a, 7)
Next a

JAM
I solved all my problems with the summary code. I wish I understood the code better so I could make these changes. Your help is very appreciated.

 

[Damon Ostrander]

Hi again Jam,

I believe this code addresses all three of the changes you wanted with the FilterSummaryDates macro (hard-wired to column C, not creating a new extraction sheet if one already exists, and header starting in row 4).

Sub FilterSummaryDates()
   'Extracts date rows from Summary sheet and places them on new sheet
   Dim iRow    As Long
   Dim dCol    As Variant     'Date column specifier
   Dim Drng    As Range       'Range containing filter dates
   Dim dRow    As Integer     'row within FilterDates range
   Dim ShNum   As Integer
   Dim ShName  As String
   Dim ShRow   As Long        'row on destination sheet
   
   Set Drng = Range("FilterDates")
   
   'dCol = InputBox("Enter Summary sheet column containing dates to be filtered" & vbLf & _
   '                "Can be either number of letters (e.g., ""B"" or ""2"", without quotes)", _
   '                "Identify column", "A")
   dCol = "C"  'or 3
                   
   If IsNumeric(dCol) Then dCol = CInt(dCol)
   
   'create new sheet
   ShNum = 1
   ShName = "Extracted Dates"
   If SheetExists(ShName) Then
      Worksheets(ShName).Activate
      'clear all cells on the existing sheet
      Cells.ClearContents
   Else
      Worksheets.Add after:=Worksheets("Summary")
      ActiveSheet.Name = ShName
   End If
   ShRow = 5      'Start with row 5 to bypass header row in row 4
      
   With Worksheets("Summary")
      'Copy header row of Summary sheet to new (destination) sheet
      .Rows(1).Copy Destination:=Rows(4)

      For iRow = .Cells(65536, dCol).End(xlUp).Row To 2 Step -1
      
         For dRow = 1 To Drng.Rows.Count
            If Drng(dRow, 1) = .Cells(iRow, dCol) And Not IsEmpty(Drng(dRow, 1)) Then
            '  extraction date found
               .Rows(iRow).Copy Destination:=Rows(ShRow)
               .Rows(iRow).Delete
               ShRow = ShRow + 1
               Exit For
            End If
         Next dRow
         
      Next iRow
   End With
   
   'sort Extracted data by date
   Range("A4", Cells.SpecialCells(xlCellTypeLastCell)).Sort Cells(1, dCol), xlAscending, header:=xlYes
   
End Sub

Let me know if you have any problems with this.

I did not have time to look at your Summary sheet code. I'm not sure when I will be able to get to it.

Damon

 

[JAMhome]

Hi Damon

Can the code delete the worksheet tab?

In the summary macro which works great this is the code that is being used there:
wsA.Name = "Summary"
NoName: If Err.Number = 1004 Then
Application.DisplayAlerts = False
Sheets("Summary").Delete
Application.DisplayAlerts = True
wsA.Name = "Summary"

JAM

 

[Damon Ostrander]

Hi JAM,

To have the FilterSummaryDates macro delete the Summary sheet after creating all the extracted data sheet all you have to do is change

      Next iRow
   End With

to

      Next iRow
      Application.DisplayAlerts = False
      .Delete
      Application.DisplayAlerts = True
   End With

Damon

 

[JAMhome]

Hi Damon

Thank you for all the help. I finally figured out what I needed. It has been quite a learning experience.

JAM