Home > Blockchain >  vba code to get a time interval between two times
vba code to get a time interval between two times

Time:11-11

raw Data that need to filter Need an help on filtering the value between two times for example start time will be 00:00 to 14:00, I need to filter those in between values and copy the corresponding data and paste in a another sheet

Option Explicit

Sub Filter_My_Data()

Dim Data_sh As Worksheet

Dim Filter_Criteria_Sh As Worksheet

Dim Output_sh As Worksheet

Set Data_sh = ThisWorkbook.Sheets("Data")

Set Filter_Criteria_Sh = ThisWorkbook.Sheets("Filter_Criteria")

Set Output_sh = ThisWorkbook.Sheets("Output")

Output_sh.UsedRange.Clear

Data_sh.AutoFilterMode = False

Dim timelist() As long

Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria_Sh.Range("A:A")) - 2

ReDim timelist(n) As long

Dim i As Integer

For i = 0 To n

    timelist(i) = Filter_Criteria_Sh.Range("A" & i   2)

Next i

Data_sh.UsedRange.AutoFilter 3, timelist(), xlFilterValues

Data_sh.UsedRange.Copy Output_sh.Range("A1")

Data_sh.AutoFilterMode = False

MsgBox ("Data has been Copied")

End Sub

CodePudding user response:

Filter By Time Interval

Sub FilterByTimeInterval()
    
    Const StartString As String = "00:00:00"
    Const EndString As String = "14:00:00"
    
    Dim StartCrit As String: StartCrit = ">=" & CDate(StartString)
    Dim EndCrit As String: EndCrit = "<=" & CDate(EndString)
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Data")
    If sws.FilterMode Then sws.ShowAllData
    Dim srg As Range: Set srg = sws.UsedRange
    
    srg.AutoFilter 3, StartCrit, xlAnd, EndCrit
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Output")
    dws.UsedRange.Clear
    Dim dfCell As Range: Set dfCell = dws.Range("A1")
    
    srg.Copy dfCell
    
    sws.AutoFilterMode = False

End Sub
  • Related