-1

I have a spreadsheet that operators input data in, with the A column being the date, and the data is input by row. The A column is a formula that adds +1 to the date in the previous cell, going all the way down recursively to auto-populate the date as the sheet is filled out.

I have to have a report printed out at the end of every day, and I am trying to use VBA to filter the rows out by a date that the operator inputs on another sheet in cell B2. I need the macro to grab that date value, and pass it as a variable to the filter in order to pull the 12 rows of that date and paste it into a new sheet. Unfortunately, the value it pulls is not being passed, and when I put a MsgBox command in there, it shows it's pulling 12:00 AM and not a date. When using the Date variable, it also breaks the filter on the bottom macro below (trying 2 different versions just to get this working).

I'm not good with VBA, so my macros were pulled from example websites and I tailored them to what I need.

This is one macro I have tried:

Sub For_RangeCopy()
    Dim rDate As Date
    Dim rSheet As Worksheet
    Set rSheet = ThisWorkbook.Worksheets("EOS")
    rDate = CDate(rSheet.Range("B2").Value)
    MsgBox (rDate)
    ' Get the worksheets
    Dim shRead As Worksheet
    Set shRead = ThisWorkbook.Worksheets("Bi-Hourly Report")
    
    Dim shWrite As Worksheet
    Set shWrite = ThisWorkbook.Worksheets("Report")
    
    ' Get the range
    Dim rg As Range
    Set rg = shRead.Range("A1").CurrentRegion
    
    With shWrite

        ' Clear the data in output worksheet
        .Cells.ClearContents
        
        ' Set the cell formats
        '.Columns(1).NumberFormat = "dd/mm/yyyy"
        '.Columns(3).NumberFormat = "$#,##0;[Red]$#,##0"
        '.Columns(4).NumberFormat = "0"
        '.Columns(5).NumberFormat = "$#,##0;[Red]$#,##0"
        
    End With
    
    ' Read through the data
    Dim i As Long, row As Long
    row = 1
    For i = 1 To rg.Rows.Count
        
        If rg.Cells(i, 1).Value2 = rDate Or i = 1 Then
            
            ' Copy using Range.Copy
            rg.Rows(i).Copy
            shWrite.Range("A" & row).PasteSpecial xlPasteValues
            
            ' move to the next output row
            row = row + 1
            
        End If
        
    Next i
    
End Sub

And here is another Macro I have tried to use. This one actually gives me the 3 header rows which I don't need, but I don't mind, this paste is a reference for the report layout anyway, so the operators won't see this sheet. But this macro does give me the first block of the date range: 1/1/2023. I do know that the "rgCriteria As String" is likely incorrect, but that is how I get anything useful from this macro. If I change that rgCriteria to a Date, it breaks the rgData.AdvancedFilter command, and I haven't learned enough VBA to know why. And my boss wants this done today, although here I am posting here, thus it's not getting done today.

Sub AdvancedFilterExample()
    ' Get the worksheets
    Dim rSheet As Worksheet
    Set rSheet = ThisWorkbook.Worksheets("EOS")
    Dim shRead As Worksheet, shWrite As Worksheet
    Set shRead = ThisWorkbook.Worksheets("Bi-Hourly Report")
    Set shWrite = ThisWorkbook.Worksheets("Report")
    
    ' Clear any existing data
    shWrite.Cells.Clear

    ' Remove the any existing filters
    If shRead.FilterMode = True Then
        shRead.ShowAllData
    End If
    
    ' Get the source data range
    Dim rgData As Range, rgCriteria As String
    Set rgData = shRead.Range("A1").CurrentRegion
    
    ' IMPORTANT: Do not have any blank rows in the criteria range
    'Set rgCriteria = rSheet.Range("B2")
    rgCriteria = rSheet.Range("B2").Value
    MsgBox (rgCriteria)
   
    ' Apply the filter
    rgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rgCriteria _
                , CopyToRange:=shWrite.Range("A1")

 End Sub

I don't know which method of filtering and pasting is best for my situation, but I do know that the faster is better. I'm copying entire rows, and it needs to be efficient because this log contains a lot of data. I only need one of these macros to work, but I will be heavily modifying them and chaining them together with about 5 other filter/copy/paste sequences to follow, along with printOut commands after that, and finalized by clearing the sheets it pastes to, and then re-enabling all the functionality of the sheet (calculations, displaystatusbar, events, and screenupdating) all to make it quicker while the macro is running. All of these reports will be run using the macro with a button click.

Any thoughts or suggestions would be greatly appreciated. I've been struggling with this for a couple of weeks now. I'm at a loss and turning to the community that has helped me with a TON of questions over the past 20 or so years just by a Google search!

Other information: I'm using Office 365 on a Windows 10/11 machine. The headers of the sheet it filters does contain merged cells as the header is rows 1-3, there is a lot of data in this sheet that grows through the year. 12 rows per day for an entire year. These macros are written in a Module aptly named "Module 1" if that helps. I do have this workbook, and the original log saved on OneDrive that can be shared.

Ken White
  • 123,280
  • 14
  • 225
  • 444

1 Answers1

0

When using Advanced Filter your criteria range should have headers which match your data table.

Sub AdvancedFilterExample()
    Dim rSheet As Worksheet, shRead As Worksheet, shWrite As Worksheet
    Dim rgData As Range, rgCriteria As Range
    
    Set rSheet = ThisWorkbook.Worksheets("EOS")
    Set shRead = ThisWorkbook.Worksheets("Bi-Hourly Report")
    Set shWrite = ThisWorkbook.Worksheets("Report")
    
    Set rgData = shRead.Range("A1").CurrentRegion 'source data range
    
    '## criteria range needs to include a matching date header...
    Set rgCriteria = rSheet.Range("B3:B4") 'eg. "Date" in B3, date value in B4
   
    shWrite.Cells.Clear ' Clear any existing data
    
    If shRead.FilterMode = True Then shRead.ShowAllData ' Remove the any existing filters
    rgData.AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=rgCriteria, _
                        CopyToRange:=shWrite.Range("A1")
End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • In my case, the date header is A1, and the date values begin at A4 all the way to about row 9000. I will modify that part of the code and try it – Bobby Tennison Feb 16 '23 at 12:16
  • I think your header needs to be directly above where your data begins. You may need to re-format your data table... – Tim Williams Feb 16 '23 at 16:13
  • We cannot format the headers in such a way that it is 1 row as there are multiple points that are entered under multiple categories. I.E., there is a section for vats that spans 3 sub-sections, a section for vacuums that spans 2 sub-sections, chemicals, amp readings with sub-sections, etc. I initially tried formatting it with 1 row headers when creating the sheet, but it looked quite ugly. If it is impossible to utilize VBA for lookups with multi-row headers, then I may attempt to utilize VBA to turn off calculations on the report sheets until they are needed to speed things up. – Bobby Tennison Feb 18 '23 at 16:30