I am working on an Excel VBA that takes a given timeframe, pulls data,

Question

0

Asked: June 17, 20262026-06-17T23:46:35+00:00 2026-06-17T23:46:35+00:00

I am working on an Excel VBA that takes a given timeframe, pulls data,

0

I am working on an Excel VBA that takes a given timeframe, pulls data, removes extra data outside of certain parameters, and then sorts the data by machine “Riveter 01 – Riveter 22”. A chart is then created with the sorted data. When I have a user click the submit button, all data is supposed to be deleted. Also when the form closes, and reopens the data is cleared each time. (I’ve done this redundancy to try and clear the leftover data). But for somereason when I open the form, there is leftover data in the wrong column and my chart has one bar over 41,000.

I’m pasting my code with hope that someone can give an answer. I’m new to VBA so I’m sure I’m not doing everything like it should be, so feel free to let me know if something I’ve typed is stupid or unnecessary.

Private Sub Submit_Button_Click()

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''Access database

strFile = "S:\IT\Databases\Main_BE.mdb"

''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

'Rough idea
StartDate = Sheet1.[C5]
EndDate = Sheet1.[C10]

ModStartDate = StartDate - 1
ModEndDate = EndDate - 1

strSQL = "SELECT * FROM Work_Orders " _
        & "WHERE Repair_Start_Date >= #" & ModStartDate & "# " _
        & "AND Repair_Start_Date <= #" & EndDate & "# " _
        & "ORDER BY Repair_Start_Date, Repair_Start_Time"

'strSQL = "SELECT * FROM Work_Orders " _
 '       & "WHERE Repair_Start_Date Between(" & ModStartDate & "+TimeSerial(17,30,0) And (" & EndDate & "+TimeSerial(17,29,0))"



rs.Open strSQL, cn


'Deletes all contents to J500 each time

Sheet3.Range("A4:K5000").Delete True

''Pick a suitable empty worksheet for the results

Worksheets("Raw Data").Cells(4, 1).CopyFromRecordset rs

Worksheets("Raw Data").Range("H4:H5000").NumberFormat = "hh:mm AM/PM"

Sheet3.[L3] = "=Counta(H4:H500)"

Dim Counter As Integer

Counter = Sheet3.[L3] + 3

Dim CompareTime As String

CompareTime = Sheet3.Cells(4, 8)

'Do While ((Sheet3.[G4] = ModStartDate) And (TimeNo("9:30 PM") > TimeNo(CompareTime)))


    'Worksheets("Raw Data").Range("A4:L4").Select
    'Sheet3.[A4].EntireRow.Delete Shift:=xlUp
    'Worksheets("Raw Data").Cells(1, 1).Select

'Loop


Dim StringTime As String

StringTime = Sheet3.Cells(Counter, 8)

'If ((TimeNo(StringTime) > TimeNo("9:30PM")) And (Sheet3.Cells(Counter, 7) = EndDate)) Then

 '   Sheet3.[L4] = "True"
'Else

 '   Sheet3.[L4] = "False"

'End If


Do While ((TimeNo(StringTime) > TimeNo("9:29 PM")) And (Sheet3.Cells(Counter, 7) = EndDate))

    Sheet3.Cells(Counter, 7).EntireRow.Delete
    Counter = Counter - 1

Loop

With Sheet3
    Sheet2.Range("A9:K5000").Delete True
    Sheet2.Range("A9:K5000").Delete True
    Sheet2.Range("A9:K5000").Delete True
    .AutoFilterMode = False
    With .Range("F2:J500")
        .AutoFilter Field:=1, Criteria1:="Riveter 01"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A10")
        .AutoFilter Field:=1, Criteria1:="Riveter 02"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("F10")
        .AutoFilter Field:=1, Criteria1:="Riveter 03"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("K10")
        .AutoFilter Field:=1, Criteria1:="Riveter 04"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("P10")
        .AutoFilter Field:=1, Criteria1:="Riveter 05"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("U10")
        .AutoFilter Field:=1, Criteria1:="Riveter 06"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("Z10")
        .AutoFilter Field:=1, Criteria1:="Riveter 07"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AE10")
        .AutoFilter Field:=1, Criteria1:="Riveter 08"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AJ10")
        .AutoFilter Field:=1, Criteria1:="Riveter 09"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AO10")
        .AutoFilter Field:=1, Criteria1:="Riveter 10"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AT10")
        .AutoFilter Field:=1, Criteria1:="Riveter 11"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AY10")
        .AutoFilter Field:=1, Criteria1:="Riveter 12"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BD10")
        .AutoFilter Field:=1, Criteria1:="Riveter 13"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BI10")
        .AutoFilter Field:=1, Criteria1:="Riveter 14"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BN10")
        .AutoFilter Field:=1, Criteria1:="Riveter 15"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BS10")
        .AutoFilter Field:=1, Criteria1:="Riveter 16"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BX10")
        .AutoFilter Field:=1, Criteria1:="Riveter 17"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CC10")
        .AutoFilter Field:=1, Criteria1:="Riveter 18"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CH10")
        .AutoFilter Field:=1, Criteria1:="Riveter 19"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CM10")
        .AutoFilter Field:=1, Criteria1:="Riveter 20"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CR10")
        .AutoFilter Field:=1, Criteria1:="Riveter 21"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CW10")
        .AutoFilter Field:=1, Criteria1:="Riveter 22"
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("DB10")

    End With
    .AutoFilterMode = False
End With

With Sheet2
    .[B4] = "=SUM(D10:D500)"
    .[G4] = "=SUM(I10:I500)"
    .[L4] = "=SUM(M10:M500)"
    .[Q4] = "=SUM(S10:S500)"
    .[V4] = "=SUM(X10:X500)"
    .[AA4] = "=SUM(AC10:AC500)"
    .[AF4] = "=SUM(AH10:AH500)"
    .[AK4] = "=SUM(AM10:AM500)"
    .[AP4] = "=SUM(AR10:AR500)"
    .[AU4] = "=SUM(AW10:AW500)"
    .[AZ4] = "=SUM(BB10:BB500)"
    .[BE4] = "=SUM(BG10:BG500)"
    .[BJ4] = "=SUM(BL10:BL500)"
    .[BO4] = "=SUM(BQ10:BQ500)"
    .[BT4] = "=SUM(BV10:BV500)"
    .[BY4] = "=SUM(CA10:CA500)"
    .[CD4] = "=SUM(CF10:CF500)"
    .[CI4] = "=SUM(CK10:CK500)"
    .[CN4] = "=SUM(CP10:CP500)"
    .[CS4] = "=SUM(CU10:CU500)"
    .[CX4] = "=SUM(CZ10:CZ500)"
    .[DC4] = "=SUM(DE10:DE500)"



End With



''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing


End Sub


Public Function TimeNo(Time As String) As Long

'**************************************
' Name: A Compare Time Function (like you can compare dates in VB)
' Description:This will allow you to compare times. I noticed that there is a 'Date' type in VB, but no 'Time' type. So if you want to compare Dates you are fine, but for Time comparisons you are a bit stuffed. This is very simple, and will allow you to convert times into numbers so that you can make easy comparisons with them.
' By: Proxy Avoidance
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=63363&lngWId=1'for details.'**************************************

' This is the sort of code that makes you think 'Why didnt I think of that?!?
'
' EG:
' IF TimeNo("21:55:32") < TimeNo("20:40:12") Then
' msgbox "WHOOO!"
' end if
'
' The code is also cross-compatible with different time formats...
'
' IF TimeNo("21:55:32") < TimeNo("8:40PM") Then
' msgbox "WHOOO!"
' end if

TimeNo = CLng(Replace(Format(Time, "hhnnss"), ":", ""))
End Function

Report

Leave an answer
Cancel reply

You must login to add an answer.

Need An Account,

1 Answer

Editorial Team · Answer 1 · 2026-06-17T23:46:36+00:00

Editorial Team

2026-06-17T23:46:36+00:00Added an answer on June 17, 2026 at 11:46 pm

I ended up using:

Sheet3.Range("A10:L1000").Delete True
Sheet2.Range("A9:DF1000").Clear
Sheet4.Range("A9:EK1000").Clear

I only did Delete for the first one to see if there was any difference, but none that I could see.

0

Reply
Share
Share

- Report

Sign Up

Sign In

Forgot Password

The Archive Base Latest Questions

I am working on an Excel VBA that takes a given timeframe, pulls data,

Leave an answerCancel reply

1 Answer

Leave an answer
Cancel reply