Advertisement
Guest User

Untitled

a guest
Aug 29th, 2015
64
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.14 KB | None | 0 0
  1. Private Sub Submit_Button_Click()
  2.  
  3. Dim cn As Object
  4. Dim rs As Object
  5. Dim strFile As String
  6. Dim strCon As String
  7. Dim strSQL As String
  8. Dim s As String
  9. Dim i As Integer, j As Integer
  10.  
  11. ''Access database
  12.  
  13. strFile = "S:ITDatabasesMain_BE.mdb"
  14.  
  15. ''This is the Jet 4 connection string, you can get more
  16. ''here : http://www.connectionstrings.com/excel
  17.  
  18. strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"
  19.  
  20. ''Late binding, so no reference is needed
  21.  
  22. Set cn = CreateObject("ADODB.Connection")
  23. Set rs = CreateObject("ADODB.Recordset")
  24.  
  25. cn.Open strCon
  26.  
  27. 'Rough idea
  28. StartDate = Sheet1.[C5]
  29. EndDate = Sheet1.[C10]
  30.  
  31. ModStartDate = StartDate - 1
  32. ModEndDate = EndDate - 1
  33.  
  34. strSQL = "SELECT * FROM Work_Orders " _
  35. & "WHERE Repair_Start_Date >= #" & ModStartDate & "# " _
  36. & "AND Repair_Start_Date <= #" & EndDate & "# " _
  37. & "ORDER BY Repair_Start_Date, Repair_Start_Time"
  38.  
  39. 'strSQL = "SELECT * FROM Work_Orders " _
  40. ' & "WHERE Repair_Start_Date Between(" & ModStartDate & "+TimeSerial(17,30,0) And (" & EndDate & "+TimeSerial(17,29,0))"
  41.  
  42.  
  43.  
  44. rs.Open strSQL, cn
  45.  
  46.  
  47. 'Deletes all contents to J500 each time
  48.  
  49. Sheet3.Range("A4:K5000").Delete True
  50.  
  51. ''Pick a suitable empty worksheet for the results
  52.  
  53. Worksheets("Raw Data").Cells(4, 1).CopyFromRecordset rs
  54.  
  55. Worksheets("Raw Data").Range("H4:H5000").NumberFormat = "hh:mm AM/PM"
  56.  
  57. Sheet3.[L3] = "=Counta(H4:H500)"
  58.  
  59. Dim Counter As Integer
  60.  
  61. Counter = Sheet3.[L3] + 3
  62.  
  63. Dim CompareTime As String
  64.  
  65. CompareTime = Sheet3.Cells(4, 8)
  66.  
  67. 'Do While ((Sheet3.[G4] = ModStartDate) And (TimeNo("9:30 PM") > TimeNo(CompareTime)))
  68.  
  69.  
  70. 'Worksheets("Raw Data").Range("A4:L4").Select
  71. 'Sheet3.[A4].EntireRow.Delete Shift:=xlUp
  72. 'Worksheets("Raw Data").Cells(1, 1).Select
  73.  
  74. 'Loop
  75.  
  76.  
  77. Dim StringTime As String
  78.  
  79. StringTime = Sheet3.Cells(Counter, 8)
  80.  
  81. 'If ((TimeNo(StringTime) > TimeNo("9:30PM")) And (Sheet3.Cells(Counter, 7) = EndDate)) Then
  82.  
  83. ' Sheet3.[L4] = "True"
  84. 'Else
  85.  
  86. ' Sheet3.[L4] = "False"
  87.  
  88. 'End If
  89.  
  90.  
  91. Do While ((TimeNo(StringTime) > TimeNo("9:29 PM")) And (Sheet3.Cells(Counter, 7) = EndDate))
  92.  
  93. Sheet3.Cells(Counter, 7).EntireRow.Delete
  94. Counter = Counter - 1
  95.  
  96. Loop
  97.  
  98. With Sheet3
  99. Sheet2.Range("A9:K5000").Delete True
  100. Sheet2.Range("A9:K5000").Delete True
  101. Sheet2.Range("A9:K5000").Delete True
  102. .AutoFilterMode = False
  103. With .Range("F2:J500")
  104. .AutoFilter Field:=1, Criteria1:="Riveter 01"
  105. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A10")
  106. .AutoFilter Field:=1, Criteria1:="Riveter 02"
  107. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("F10")
  108. .AutoFilter Field:=1, Criteria1:="Riveter 03"
  109. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("K10")
  110. .AutoFilter Field:=1, Criteria1:="Riveter 04"
  111. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("P10")
  112. .AutoFilter Field:=1, Criteria1:="Riveter 05"
  113. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("U10")
  114. .AutoFilter Field:=1, Criteria1:="Riveter 06"
  115. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("Z10")
  116. .AutoFilter Field:=1, Criteria1:="Riveter 07"
  117. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AE10")
  118. .AutoFilter Field:=1, Criteria1:="Riveter 08"
  119. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AJ10")
  120. .AutoFilter Field:=1, Criteria1:="Riveter 09"
  121. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AO10")
  122. .AutoFilter Field:=1, Criteria1:="Riveter 10"
  123. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AT10")
  124. .AutoFilter Field:=1, Criteria1:="Riveter 11"
  125. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("AY10")
  126. .AutoFilter Field:=1, Criteria1:="Riveter 12"
  127. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BD10")
  128. .AutoFilter Field:=1, Criteria1:="Riveter 13"
  129. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BI10")
  130. .AutoFilter Field:=1, Criteria1:="Riveter 14"
  131. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BN10")
  132. .AutoFilter Field:=1, Criteria1:="Riveter 15"
  133. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BS10")
  134. .AutoFilter Field:=1, Criteria1:="Riveter 16"
  135. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("BX10")
  136. .AutoFilter Field:=1, Criteria1:="Riveter 17"
  137. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CC10")
  138. .AutoFilter Field:=1, Criteria1:="Riveter 18"
  139. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CH10")
  140. .AutoFilter Field:=1, Criteria1:="Riveter 19"
  141. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CM10")
  142. .AutoFilter Field:=1, Criteria1:="Riveter 20"
  143. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CR10")
  144. .AutoFilter Field:=1, Criteria1:="Riveter 21"
  145. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("CW10")
  146. .AutoFilter Field:=1, Criteria1:="Riveter 22"
  147. .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("DB10")
  148.  
  149. End With
  150. .AutoFilterMode = False
  151. End With
  152.  
  153. With Sheet2
  154. .[B4] = "=SUM(D10:D500)"
  155. .[G4] = "=SUM(I10:I500)"
  156. .[L4] = "=SUM(M10:M500)"
  157. .[Q4] = "=SUM(S10:S500)"
  158. .[V4] = "=SUM(X10:X500)"
  159. .[AA4] = "=SUM(AC10:AC500)"
  160. .[AF4] = "=SUM(AH10:AH500)"
  161. .[AK4] = "=SUM(AM10:AM500)"
  162. .[AP4] = "=SUM(AR10:AR500)"
  163. .[AU4] = "=SUM(AW10:AW500)"
  164. .[AZ4] = "=SUM(BB10:BB500)"
  165. .[BE4] = "=SUM(BG10:BG500)"
  166. .[BJ4] = "=SUM(BL10:BL500)"
  167. .[BO4] = "=SUM(BQ10:BQ500)"
  168. .[BT4] = "=SUM(BV10:BV500)"
  169. .[BY4] = "=SUM(CA10:CA500)"
  170. .[CD4] = "=SUM(CF10:CF500)"
  171. .[CI4] = "=SUM(CK10:CK500)"
  172. .[CN4] = "=SUM(CP10:CP500)"
  173. .[CS4] = "=SUM(CU10:CU500)"
  174. .[CX4] = "=SUM(CZ10:CZ500)"
  175. .[DC4] = "=SUM(DE10:DE500)"
  176.  
  177.  
  178.  
  179. End With
  180.  
  181.  
  182.  
  183. ''Tidy up
  184. rs.Close
  185. Set rs = Nothing
  186. cn.Close
  187. Set cn = Nothing
  188.  
  189.  
  190. End Sub
  191.  
  192.  
  193. Public Function TimeNo(Time As String) As Long
  194.  
  195. '**************************************
  196. ' Name: A Compare Time Function (like you can compare dates in VB)
  197. ' 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.
  198. ' By: Proxy Avoidance
  199. '
  200. '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.'**************************************
  201.  
  202. ' This is the sort of code that makes you think 'Why didnt I think of that?!?
  203. '
  204. ' EG:
  205. ' IF TimeNo("21:55:32") < TimeNo("20:40:12") Then
  206. ' msgbox "WHOOO!"
  207. ' end if
  208. '
  209. ' The code is also cross-compatible with different time formats...
  210. '
  211. ' IF TimeNo("21:55:32") < TimeNo("8:40PM") Then
  212. ' msgbox "WHOOO!"
  213. ' end if
  214.  
  215. TimeNo = CLng(Replace(Format(Time, "hhnnss"), ":", ""))
  216. End Function
  217.  
  218. Sheet3.Range("A10:L1000").Delete True
  219. Sheet2.Range("A9:DF1000").Clear
  220. Sheet4.Range("A9:EK1000").Clear
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement