API tools faq
paste
Guest User

Untitled

a guest
Feb 19th, 2018
102
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 10.04 KB | None | 0 0
raw download clone embed print report
  1. Sub breakdown()
  2.  
  3. Dim i As Integer
  4. Dim counter As Integer
  5. Dim sumorder As Long
  6. Dim sumunits As Long
  7. Dim counterorders As Long
  8. Dim counterunits As Long
  9. Dim counteryear As Integer
  10. counteryear = 0
  11. Dim y As Integer
  12. Dim m As Integer
  13. Dim d As Integer
  14. Dim c As Integer
  15. Dim counter2 As Integer
  16. counter2 = 2
  17. Dim counter3 As Integer
  18. counter3 = 0
  19. c = 2
  20. Dim q As Integer
  21. q = 0
  22.  
  23.  
  24.                    'Sort Data from Old to New in order for code to run properly'
  25.  
  26. 'Sort Daily from Oldest to Current'
  27.     ActiveWorkbook.Worksheets("Daily").AutoFilter.Sort.SortFields.Clear
  28.     ActiveWorkbook.Worksheets("Daily").AutoFilter.Sort.SortFields.Add Key:=Range( _
  29.         "B1:B3650"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  30.         xlSortNormal
  31.     With ActiveWorkbook.Worksheets("Daily").AutoFilter.Sort
  32.         .Header = xlYes
  33.         .MatchCase = False
  34.         .Orientation = xlTopToBottom
  35.         .SortMethod = xlPinYin
  36.         .Apply
  37.     End With
  38.    
  39.     'Sort Weekly from Oldest to Current'
  40.        ActiveWorkbook.Worksheets("Weekly").AutoFilter.Sort.SortFields.Clear
  41.     ActiveWorkbook.Worksheets("Weekly").AutoFilter.Sort.SortFields.Add Key:=Range _
  42.         ("A1:A562"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  43.         xlSortNormal
  44.     With ActiveWorkbook.Worksheets("Weekly").AutoFilter.Sort
  45.         .Header = xlYes
  46.         .MatchCase = False
  47.         .Orientation = xlTopToBottom
  48.         .SortMethod = xlPinYin
  49.         .Apply
  50.     End With
  51.    
  52.     'Sort Monthly from Oldest to Current'
  53.    ActiveWorkbook.Worksheets("Monthly").AutoFilter.Sort.SortFields.Clear
  54.     ActiveWorkbook.Worksheets("Monthly").AutoFilter.Sort.SortFields.Add Key:= _
  55.         Range("A1:A133"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
  56.         :=xlSortNormal
  57.     With ActiveWorkbook.Worksheets("Monthly").AutoFilter.Sort
  58.         .Header = xlYes
  59.         .MatchCase = False
  60.         .Orientation = xlTopToBottom
  61.         .SortMethod = xlPinYin
  62.         .Apply
  63.     End With
  64.    
  65.     'Sort Quarterly from Oldest to Current'
  66.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Clear
  67.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Add Key:= _
  68.         Range("D1:D48"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
  69.         :=xlSortNormal
  70.     With ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort
  71.         .Header = xlYes
  72.         .MatchCase = False
  73.         .Orientation = xlTopToBottom
  74.         .SortMethod = xlPinYin
  75.         .Apply
  76.     End With
  77.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Clear
  78.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Add Key:= _
  79.         Range("A1:A48"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  80.         xlSortNormal
  81.     With ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort
  82.         .Header = xlYes
  83.         .MatchCase = False
  84.         .Orientation = xlTopToBottom
  85.         .SortMethod = xlPinYin
  86.         .Apply
  87.     End With
  88.    
  89.     'Sort Yearly from Oldest to Current'
  90.    ActiveWorkbook.Worksheets("Yearly").AutoFilter.Sort.SortFields.Clear
  91.     ActiveWorkbook.Worksheets("Yearly").AutoFilter.Sort.SortFields.Add Key:=Range _
  92.         ("A1:A13"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  93.         xlSortNormal
  94.     With ActiveWorkbook.Worksheets("Yearly").AutoFilter.Sort
  95.         .Header = xlYes
  96.         .MatchCase = False
  97.         .Orientation = xlTopToBottom
  98.         .SortMethod = xlPinYin
  99.         .Apply
  100.     End With
  101.  
  102.                                 'Compile Data'
  103. 'Weekly Sheet!!'
  104. counter = 0
  105. For i = 4 To 3650
  106. 'Running Tally through the days'
  107.   sumorder = sumorder + Sheets("Daily").Cells(i, 3)
  108.    sumunits = sumunits + Sheets("Daily").Cells(i, 4)
  109.    
  110.   'Checks the week as the running tally progresses. Every 7 days = output'
  111. If ((i - 3) Mod 7 = 0) Then
  112.       Sheets("Weekly").Cells(counter + 3, 2) = sumorder
  113.       Sheets("Weekly").Cells(counter + 3, 3) = sumunits
  114.       counter = counter + 1
  115.       sumorder = 0
  116.     sumunits = 0
  117.  End If
  118. Next i
  119. counter = counter + 1
  120. Sheets("Weekly").Cells(counter + 3, 2) = sumorder
  121. Sheets("Weekly").Cells(counter + 3, 3) = sumunits
  122.  
  123.  
  124. For r = 2 To 600
  125. 'Cleans out generated zeroes'
  126. If Sheets("Weekly").Cells(r, 2) = 0 Then
  127. Sheets("Weekly").Cells(r, 2) = ""
  128. Sheets("Weekly").Cells(r, 3) = ""
  129. End If
  130. Next r
  131.  
  132.  'Monthly Sheet!!'
  133. For y = 2011 To 2021
  134. For m = 1 To 12
  135. counterorders = 0
  136. counterunits = 0
  137. 'Runs through data, one month at a time. Compiles it as monthly sums. Resets
  138. 'after each month'
  139. For d = 1 To 31
  140.  
  141.  
  142.  
  143. If Sheets("Daily").Cells(c, 2) = (m + 3) & "/" & (d) & "/" & (y) Then
  144. counterorders = counterorders + Sheets("Daily").Cells(c, 3)
  145. counterunits = counterunits + Sheets("Daily").Cells(c, 4)
  146. c = c + 1
  147.  
  148.  
  149.  
  150. End If
  151.  
  152.  
  153.  
  154. Next d
  155. 'Output the compilation. Reset counter'
  156. countermonth = countermonth + 1
  157. Sheets("Monthly").Cells(countermonth + 1 + counteryear, 2) = counterorders
  158. Sheets("Monthly").Cells(countermonth + 1 + counteryear, 3) = counterunits
  159. Next m
  160. counterorders = 0
  161. counterunits = 0
  162.  
  163. Next y
  164. counteryear = 12 * counteryear
  165.  
  166.  
  167.  
  168. 'Clear out generated zeroes'
  169. For i = 2 To 150
  170. If Sheets("Monthly").Cells(i, 2) = 0 Then
  171. Sheets("Monthly").Cells(i, 2) = ""
  172. Sheets("Monthly").Cells(i, 3) = ""
  173. End If
  174. Next i
  175.  
  176.  
  177. counterorders = 0
  178. counterunits = 0
  179. y = 0
  180.  
  181. 'Quarterly Sheet!!'
  182. For y = 1 To 40
  183.  
  184. For q = 1 To 3
  185. counterorders = counterorders + Sheets("Monthly").Cells(q + 1 + counter3, 2)
  186. counterunits = counterunits + Sheets("Monthly").Cells(q + 1 + counter3, 3)
  187.  
  188. 'Counter 3 shifts by 3 by reason 3 months per qtr. Counter 2 is the row shifter for output'
  189. Next q
  190. Sheets("Quarterly").Cells(counter2, 2) = counterorders
  191. Sheets("Quarterly").Cells(counter2, 3) = counterunits
  192. counter2 = counter2 + 1
  193. counterorders = 0
  194. counterunits = 0
  195. counter3 = counter3 + 3
  196. Next y
  197.  
  198. 'Clearing out generated zeroes'
  199. For i = 2 To 45
  200. If Sheets("Quarterly").Cells(i, 2) = 0 Then
  201. Sheets("Quarterly").Cells(i, 2) = ""
  202. Sheets("Quarterly").Cells(i, 3) = ""
  203. End If
  204. Next i
  205.  
  206. c = 2
  207.  
  208. 'Yearly Sheet!!'
  209. For y = 2011 To 2021
  210. counterunits = 0
  211. counterorders = 0
  212. counteryear = counteryear + 1
  213. For m = 1 To 12
  214. 'Runs through the days in a year, and if there is data for a given date within a year,
  215. 'it adds it to the tally
  216. For d = 1 To 31
  217.  
  218.  
  219.  
  220. If Sheets("Daily").Cells(c, 2) = (m + 3) & "/" & (d) & "/" & (y) Then
  221. counterorders = counterorders + Sheets("Daily").Cells(c, 3)
  222. counterunits = counterunits + Sheets("Daily").Cells(c, 4)
  223. c = c + 1
  224.  
  225.  
  226.  
  227. End If
  228.  
  229.  
  230.  
  231. Next d
  232.  
  233.  
  234. Next m
  235. 'Outputs yearly data, shifts row(countermonth) to next year'
  236. countermonth = countermonth + 1
  237. Sheets("Yearly").Cells(counteryear + 1, 2) = counterorders
  238. Sheets("Yearly").Cells(counteryear + 1, 3) = counterunits
  239. Next y
  240.  
  241. 'Clear out generated zeroes'
  242. For i = 2 To 13
  243. If Sheets("Yearly").Cells(i, 2) = 0 Then
  244. Sheets("Yearly").Cells(i, 2) = ""
  245. Sheets("Yearly").Cells(i, 3) = ""
  246. End If
  247. Next i
  248.  
  249.  
  250.                         'Sort Data from Current to Old for Display'
  251.                  
  252.  'Sort Daily from Current to Old'
  253.     ActiveWorkbook.Worksheets("Daily").AutoFilter.Sort.SortFields.Clear
  254.     ActiveWorkbook.Worksheets("Daily").AutoFilter.Sort.SortFields.Add Key:=Range( _
  255.         "B1:B3650"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  256.         xlSortNormal
  257.     With ActiveWorkbook.Worksheets("Daily").AutoFilter.Sort
  258.         .Header = xlYes
  259.         .MatchCase = False
  260.         .Orientation = xlTopToBottom
  261.         .SortMethod = xlPinYin
  262.         .Apply
  263.     End With
  264.    
  265.     'Sort Weekly from Current to Old'
  266.        ActiveWorkbook.Worksheets("Weekly").AutoFilter.Sort.SortFields.Clear
  267.     ActiveWorkbook.Worksheets("Weekly").AutoFilter.Sort.SortFields.Add Key:=Range _
  268.         ("A1:A562"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  269.         xlSortNormal
  270.     With ActiveWorkbook.Worksheets("Weekly").AutoFilter.Sort
  271.         .Header = xlYes
  272.         .MatchCase = False
  273.         .Orientation = xlTopToBottom
  274.         .SortMethod = xlPinYin
  275.         .Apply
  276.     End With
  277.    
  278.     'Sort Monthly from Current to Old'
  279.    ActiveWorkbook.Worksheets("Monthly").AutoFilter.Sort.SortFields.Clear
  280.     ActiveWorkbook.Worksheets("Monthly").AutoFilter.Sort.SortFields.Add Key:= _
  281.         Range("A1:A133"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
  282.         :=xlSortNormal
  283.     With ActiveWorkbook.Worksheets("Monthly").AutoFilter.Sort
  284.         .Header = xlYes
  285.         .MatchCase = False
  286.         .Orientation = xlTopToBottom
  287.         .SortMethod = xlPinYin
  288.         .Apply
  289.     End With
  290.    
  291.     'Sort Quarterly from Current to Old'
  292.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Clear
  293.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Add Key:= _
  294.         Range("D1:D48"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
  295.         :=xlSortNormal
  296.     With ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort
  297.         .Header = xlYes
  298.         .MatchCase = False
  299.         .Orientation = xlTopToBottom
  300.         .SortMethod = xlPinYin
  301.         .Apply
  302.     End With
  303.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Clear
  304.     ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort.SortFields.Add Key:= _
  305.         Range("A1:A48"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  306.         xlSortNormal
  307.     With ActiveWorkbook.Worksheets("Quarterly").AutoFilter.Sort
  308.         .Header = xlYes
  309.         .MatchCase = False
  310.         .Orientation = xlTopToBottom
  311.         .SortMethod = xlPinYin
  312.         .Apply
  313.     End With
  314.    
  315.     'Sort Yearly from Current to Old'
  316.    ActiveWorkbook.Worksheets("Yearly").AutoFilter.Sort.SortFields.Clear
  317.     ActiveWorkbook.Worksheets("Yearly").AutoFilter.Sort.SortFields.Add Key:=Range _
  318.         ("A1:A13"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  319.         xlSortNormal
  320.     With ActiveWorkbook.Worksheets("Yearly").AutoFilter.Sort
  321.         .Header = xlYes
  322.         .MatchCase = False
  323.         .Orientation = xlTopToBottom
  324.         .SortMethod = xlPinYin
  325.         .Apply
  326.     End With
  327.  
  328. End Sub
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!