my codes to filter is giving me inaccurate results. pls help to check

stanco

New Member
Joined
Mar 16, 2019
Messages
48
background: i have a code that will filter my table based on start and end date keyed in by me. the table consist of company names and the date of surveys that they have completed. the code is supposed to filter out all the survey 2 dates that are within the start and end date, then filter survey 3 and so forth. (if the company have two or more surveys that are within the same date range, it will be captured as one row, with the survey dates in the corresponding columns. )


Code:
Sub dateCheck()    Dim sht, sht2 As Worksheet
    Dim xStartDate As Date
    Dim xEndDate As Date
    Dim xDate As Date
    
    Set sht = ThisWorkbook.Worksheets("Engagement Log")
    Set sht2 = ThisWorkbook.Worksheets("Certs")
    
    
    a = sht.Cells(Rows.Count, 2).End(xlUp).Row
    b = sht.Cells(1, Columns.Count).End(xlToLeft).Column
    xcol = Replace(ActiveSheet.Cells(1, b).Address(True, False), "$1", "")
    rng = sht.Range("A1:" & xcol & 1)
     
    
    
    a2 = sht2.Cells(Rows.Count, 2).End(xlUp).Row
    If a2 > 5 Then sht2.Range("A6:A" & a2).EntireRow.Delete
    a2 = sht2.Cells(Rows.Count, 2).End(xlUp).Row
    j = a2
    b2 = sht2.Cells(5, Columns.Count).End(xlToLeft).Column
    xcol2 = Replace(ActiveSheet.Cells(1, b2).Address(True, False), "$1", "")
    Rng2 = sht2.Range("A5:" & xcol2 & 5)
    
    
    
    xSurveyCount = sht2.Range("H1").Value
    xStartDate = sht2.Range("B1").Value
    xEndDate = sht2.Range("B2").Value
    
    Set RowRange = sht.Range("B2:B" & a)
    
    For Each rowvalue In RowRange
        xrow = rowvalue.Row
        
        xCert = sht.Cells(xrow, 1).Value
        xUEN = sht.Cells(xrow, 2).Value
        xCName = sht.Cells(xrow, 3).Value
'        xSProject = sht.Cells(xrow, 4).Value
'        xSector = sht.Cells(xrow, 8).Value
        Z = 0
        For i = 2 To xSurveyCount
            d = Application.WorksheetFunction.Match("SURVEY " & i & " DATE", rng, 0)
            xDate = sht.Cells(xrow, d).Value
            d2 = Application.WorksheetFunction.Match("SURVEY " & i & " DATE", Rng2, 0)
            If xDate >= xStartDate And xDate <= xEndDate Then
'                d2 = Application.WorksheetFunction.Match("SURVEY " & i & " DATE", Rng2, 0)
                If xCert <> sht2.Cells(j, 1).Value And xUEN <> xUEN2 And xCName <> sht.Cells(j, 3).Value Then
                  z2 = d2
                  Z = Z + 1
                  j = j + 1
                  sht2.Cells(j, 1).Value = sht.Cells(xrow, 1).Value
                  sht2.Cells(j, 2).Value = sht.Cells(xrow, 3).Value
                  sht2.Cells(j, 3).Value = sht.Cells(xrow, 4).Value
                  sht2.Cells(j, 4).Value = sht.Cells(xrow, 8).Value
                  
                  sht2.Cells(j, d2).Value = sht.Cells(xrow, d).Value
                Else
                 z2 = d2
                 Z = Z + 1
                 sht2.Cells(j, d2).Value = sht.Cells(xrow, d).Value
                End If
            End If
        Next
'        If Z >= 2 Then xZdate = sht2.Cells(j, z2).Value
'        If Z >= 2 Then xZdate1 = sht2.Cells(j, z2 - 1).Value
'        If Z >= 2 And xZdate > xZdate1 Then sht2.Cells(j, d2 + 1).Value = sht2.Cells(j, z2).Value - sht2.Cells(j, z2 - 1).Value
        If Z >= 1 Then sht2.Cells(j, d2 + 1).Value = sht2.Cells(j, z2).Value


        xUEN2 = xUEN
    Next
    MsgBox "Task is Completed"
End Sub




this is the results that were returned by the code
or101e.png





but if i were to manually filter, i will get 19 counts for survey 2 and 7 counts for survey 3, whereas the code is returning me 13 and 5 counts respectively.

sb4yu0.png


33jqzpy.png



can you help me figure out what is wrong and how to correct it please?
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top