-
Notifications
You must be signed in to change notification settings - Fork 0
/
VBA_Challenge.vbs
398 lines (395 loc) · 16.3 KB
/
VBA_Challenge.vbs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
Attribute VB_Name = "Module2_VBA_Script"
'Coded by: Parto Tandjoeng
'Reference: https://docs.microsoft.com/en-us/office/vba/api/overview/language-reference
Option Explicit
Sub AllStocksAnalysisRefactored()
appOff
Dim yearvalue As String, startSS As Single, endSS As Single 'year string, timer var in seconds
yearvalue = InputBox("What year would you like to run the analysis on?", "After refactoring", "2018")
If yearvalue = vbNullString Then 'Exit module when users press Cancel button
Exit Sub
End If
startSS = Timer 'start timer
'Create array with all tickers and 3 output arrays with more efficient data types for avoiding Array() method
Dim tickers() As String, tickerVolumes(11) As Long, tickerStartingPrices(11) As Single, tickerEndingPrices(11) As Single
'Create a ticker Index, establish the number of rows to loop over
Dim tickerIndex As Byte, rowEnd As Integer, i As Integer
'Format the output sheet on All Stocks Analysis worksheet
Worksheets("All Stocks Analysis").Activate
'Create a header row w/ Cells method
Cells(1, 1) = "All Stocks (" + yearvalue + ")": Cells(3, 1) = "Ticker": Cells(3, 2) = "Total Daily Volume": Cells(3, 3) = "Return"
tickers = Split("AY,CSIQ,DQ,ENPH,FSLR,HASI,JKS,RUN,SEDG,SPWR,TERP,VSLR", ",")
Worksheets(yearvalue).Activate: rowEnd = Cells(Rows.Count, 1).End(xlUp).Row 'last non-empty row
' Dim initializes each empty value to empty or 0 before we use it
' For i = 1 To 11
' Debug.Print tickers(i), tickerVolumes(i), tickerStartingPrices(i), tickerEndingPrices(i)
' Next
'Reduce number of loops
If Cells(2, 1) = tickers(0) Then
tickerStartingPrices(0) = Cells(2, 6): tickerVolumes(0) = Cells(2, 8)
End If
For tickerIndex = 0 To UBound(tickers)
'Create a for loop to initialize the tickerVolumes to zero (unnecessary)
'Loop over all the rows in the spreadsheet
For i = 3 To (rowEnd - 1)
If Cells(i, 1) = tickers(tickerIndex) Then
'Increase volume for current ticker
tickerVolumes(tickerIndex) = tickerVolumes(tickerIndex) + Cells(i, 8)
'Check if the current row is the first row with the selected ticker
If Cells(i - 1, 1) <> tickers(tickerIndex) Then
tickerStartingPrices(tickerIndex) = Cells(i, 6)
GoTo nextI
'Check if the current row is the last row with the selected ticker
ElseIf Cells(i + 1, 1) <> tickers(tickerIndex) Then
tickerEndingPrices(tickerIndex) = Cells(i, 6)
GoTo nextI
End If
End If
nextI:
Next i
Next tickerIndex
'Reduce number of loops
If Cells(rowEnd, 1) = tickers(UBound(tickers)) Then
tickerEndingPrices(UBound(tickers)) = Cells(rowEnd, 6): tickerVolumes(UBound(tickers)) = tickerVolumes(UBound(tickers)) + Cells(rowEnd, 8)
End If
'Output results to a table and format it
Worksheets("All Stocks Analysis").Activate
For tickerIndex = 0 To UBound(tickers)
Cells(4 + tickerIndex, 1) = tickers(tickerIndex): Cells(4 + tickerIndex, 2) = tickerVolumes(tickerIndex)
Cells(4 + tickerIndex, 3) = (tickerEndingPrices(tickerIndex) / tickerStartingPrices(tickerIndex)) - 1
Next tickerIndex
'Formatting
Cells(1, 1).Font.Bold = True
With Range(Cells(3, 1), Cells(3, 3))
.Font.Bold = True: .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Range(Cells(4, 2), Cells(15, 2)).NumberFormat = "#,##0": Columns(2).AutoFit
Range(Cells(4, 3), Cells(15, 3)).NumberFormat = "0.0%": rowEnd = Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To rowEnd
If Cells(i, 3) > 0 Then
Cells(i, 3).Interior.Color = vbGreen 'Color the cell green
ElseIf Cells(i, 3) < 0 Then
Cells(i, 3).Interior.Color = vbRed 'Color the cell red
Else
Cells(i, 3).Interior.Color = xlNone 'Clear the cell color
End If
Next i
endSS = Timer 'stop timer
MsgBox "This code ran in " & (endSS - startSS) & " seconds for the year " & yearvalue
appOn
End Sub
Sub AllStocksAnalysisRefactoredNoComment()
appOff
Dim yearvalue As String, startSS As Single, endSS As Single
yearvalue = InputBox("What year would you like to run the analysis on?", "After refactoring", "2018")
If yearvalue = vbNullString Then
Exit Sub
End If
startSS = Timer
Dim tickers() As String, tickerVolumes(11) As Long, tickerStartingPrices(11) As Single, tickerEndingPrices(11) As Single: Dim tickerIndex As Byte, rowEnd As Integer, i As Integer
Worksheets("All Stocks Analysis").Activate: Cells(1, 1) = "All Stocks (" + yearvalue + ")": Cells(3, 1) = "Ticker": Cells(3, 2) = "Total Daily Volume": Cells(3, 3) = "Return"
tickers = Split("AY,CSIQ,DQ,ENPH,FSLR,HASI,JKS,RUN,SEDG,SPWR,TERP,VSLR", ","): Worksheets(yearvalue).Activate: rowEnd = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(2, 1) = tickers(0) Then
tickerStartingPrices(0) = Cells(2, 6): tickerVolumes(0) = Cells(2, 8)
End If
tickerIndex = 0
Do While tickerIndex <= UBound(tickers)
For i = 3 To (rowEnd - 1)
If Cells(i, 1) = tickers(tickerIndex) Then
tickerVolumes(tickerIndex) = tickerVolumes(tickerIndex) + Cells(i, 8)
If Cells(i - 1, 1) <> tickers(tickerIndex) Then
tickerStartingPrices(tickerIndex) = Cells(i, 6)
GoTo nextI
ElseIf Cells(i + 1, 1) <> tickers(tickerIndex) Then
tickerEndingPrices(tickerIndex) = Cells(i, 6)
GoTo nextI
End If
End If
nextI:
Next i
tickerIndex = tickerIndex + 1
Loop
If Cells(rowEnd, 1) = tickers(11) Then
tickerEndingPrices(11) = Cells(rowEnd, 6): tickerVolumes(11) = tickerVolumes(11) + Cells(rowEnd, 8)
End If
Worksheets("All Stocks Analysis").Activate: tickerIndex = 0
Do While tickerIndex <= UBound(tickers)
Cells(4 + tickerIndex, 1) = tickers(tickerIndex): Cells(4 + tickerIndex, 2) = tickerVolumes(tickerIndex): Cells(4 + tickerIndex, 3) = (tickerEndingPrices(tickerIndex) / tickerStartingPrices(tickerIndex)) - 1
tickerIndex = tickerIndex + 1
Loop
Cells(1, 1).Font.Bold = True
With Range(Cells(3, 1), Cells(3, 3))
.Font.Bold = True: .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Range(Cells(4, 2), Cells(15, 2)).NumberFormat = "#,##0": Columns(2).AutoFit: Range(Cells(4, 3), Cells(15, 3)).NumberFormat = "0.0%": rowEnd = Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To rowEnd
If Cells(i, 3) > 0 Then
Cells(i, 3).Interior.Color = vbGreen
ElseIf Cells(i, 3) < 0 Then
Cells(i, 3).Interior.Color = vbRed
Else
Cells(i, 3).Interior.Color = xlNone
End If
Next i
endSS = Timer
MsgBox "This code ran in " & (endSS - startSS) & " seconds for the year " & yearvalue
appOn
End Sub
Sub AllStocksAnalysis()
Dim yearvalue As String
Dim startSS As Single, endSS As Single 'seconds
yearvalue = InputBox("What year would you like to run the analysis on?", "Before refactoring", "2018")
If yearvalue = "" Then 'Exit module when users press Cancel button
Exit Sub
End If
startSS = Timer
'Format the output sheet on All Stocks Analysis worksheet
Worksheets("All Stocks Analysis").Activate
' ClearWorksheet "All Stocks Analysis" 'clear cells
'Create a header row w/ Range method
Range("A1").Value = "All Stocks (" + yearvalue + ")"
Range("A" & 3).Value = "Ticker"
Range("B" & 3).Value = "Total Daily Volume" ': Columns(2).AutoFit
Range("C" & 3).Value = "Return"
' 'Create a header row w/ Cells method
' Cells(1, 1).Value = "All Stocks (" + yearvalue + ")"
' Cells(3, 1).Value = "Ticker"
' Cells(3, 2).Value = "Total Daily Volume": Columns(2).AutoFit
' Cells(3, 3).Value = "Return"
Dim id As Integer, i As Integer, rowEnd As Integer, colEnd As Integer
Dim startingPrice As Double, endingPrice As Double
'Initialize array of all tickers
Dim ticker As String, tickers() As String
tickers = Split("AY,CSIQ,DQ,ENPH,FSLR,HASI,JKS,RUN,SEDG,SPWR,TERP,VSLR", ",")
' Dim tickers As Variant 'Variant data type is not efficient
' tickers = Array("AY", "CSIQ", "DQ", "ENPH", "FSLR", "HASI", "JKS", "RUN", "SEDG", "SPWR", "TERP", "VSLR")
Dim totalVolume As Long: totalVolume = 0 'reset totalVolume
'establish the number of rows to loop over
Dim rowStart As Integer: rowStart = 2
Worksheets(yearvalue).Activate
rowEnd = Cells(Rows.Count, 1).End(xlUp).Row 'last non-empty row
' colEnd = Cells(1, Columns.Count).End(xlToLeft).Column 'last non-empty col
For id = LBound(tickers) To UBound(tickers)
ticker = tickers(id)
totalVolume = 0
Worksheets(yearvalue).Activate
For i = rowStart To rowEnd 'loop over all the rows
If Cells(i, 1).Value = ticker Then
If Cells(i - 1, 1).Value <> ticker Then
startingPrice = Cells(i, 6).Value
ElseIf Cells(i + 1, 1).Value <> ticker Then
endingPrice = Cells(i, 6).Value
End If
totalVolume = totalVolume + Cells(i, 8).Value 'increase totalVolume by the value in the current row
End If
Next i
Worksheets("All Stocks Analysis").Activate
Cells(4 + id, 1).Value = ticker
Cells(4 + id, 2).Value = totalVolume
Cells(4 + id, 3).Value = endingPrice / startingPrice - 1
Next id
formatAllStocksAnalysisTableBetter
endSS = Timer
' Debug.Print yearvalue & ", Before refactoring, " & (endSS - startSS)
MsgBox "This code ran in " & (endSS - startSS) & " seconds for the year " & yearvalue
End Sub
Sub DQAnalysis()
appOff
Dim i As Integer, rowEnd As Integer, colEnd As Integer
Dim startingPrice As Double, endingPrice As Double
Dim totalVolume As Long: totalVolume = 0 'reset totalVolume
'establish the number of rows to loop over
Dim rowStart As Integer: rowStart = 2
Worksheets("DQ Analysis").Activate
' Range(Cells(1, 1), Cells(3, 3)).Clear
'Create a header row
Cells(1, 1).Value = "DAQO (Ticker: DQ)"
Cells(3, 1).Value = "Year"
Cells(3, 2).Value = "Total Daily Volume": Columns(2).AutoFit
Cells(3, 3).Value = "Return"
Cells(3, 4).Value = "Starting Price"
Cells(3, 5).Value = "Ending Price"
Worksheets("2018").Activate
rowEnd = Cells(Rows.Count, 1).End(xlUp).Row 'last non-empty row
colEnd = Cells(1, Columns.Count).End(xlToLeft).Column 'last non-empty col
' rowEnd = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'last non-empty row
' colEnd = Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column 'last non-empty col
For i = rowStart To rowEnd 'loop over all the rows
If Cells(i, 1).Value = "DQ" Then
If Cells(i - 1, 1).Value <> "DQ" Then
startingPrice = Cells(i, colEnd - 2).Value
ElseIf Cells(i + 1, 1).Value <> "DQ" Then
endingPrice = Cells(i, colEnd - 2).Value
End If
totalVolume = totalVolume + Cells(i, colEnd).Value 'increase totalVolume by the value in the current row
End If
Next i
' If (totalVolume = 107873900) Then MsgBox ("Numbers matched")
Worksheets("DQ Analysis").Activate
Cells(4, 1).Value = 2018
Cells(4, 2).Value = totalVolume
Cells(4, 3).Value = endingPrice / startingPrice - 1: Cells(4, 3).NumberFormat = "0.00%"
Cells(4, 4).Value = startingPrice
Cells(4, 5).Value = endingPrice
Range(Cells(4, 4), Cells(4, 5)).NumberFormat = "$ #.#0"
Application.ScreenUpdating = True
End Sub
Sub chkbrd()
Dim newWS As Worksheet
Const myWS As String = "chkbrd"
Dim myRow As Integer, myCol As Integer, myRC As String, myRCs() As String 'X * Y sizes of the checkerboard pattern
On Error GoTo ErrHandler
Set newWS = Sheets.Add(After:=Worksheets(Worksheets.Count)): newWS.Name = myWS 'add/rename sheet
On Error GoTo 0
myRC = InputBox("Input number as ROW*COLUMN, for example 2*8, 8*8, or anything like X*Y:", "Checkerboard Maker", "16*16")
If myRC = vbNullString Then 'Exit module when users press Cancel button
Exit Sub
End If
If InStr(myRC, "*") > 0 Then
myRCs = Split(myRC, "*")
ElseIf InStr(myRC, "x") > 0 Then
myRCs = Split(myRC, "x")
Else
Exit Sub
End If
presetWS 'clear cells
myRow = myRCs(0): myCol = myRCs(1)
If myRow < 8 Then
makechkbrd myRow, myCol, vbRed, vbGreen '4x4 checkerboard pattern w/ specified colors
ElseIf myRow >= 16 Then
makechkbrd myRow, myCol '8x8 checkerboard pattern with default BW colors
Else
makechkbrd myRow, myCol, vbMagenta, vbCyan '16x16 checkerboard pattern w/ specified colors
End If
' presetWS 'clear cells
' makechkbrd 8, 8 '8x8 checkerboard pattern with default BW colors
Exit Sub
ErrHandler:
'delete worksheet w/o prompt
Application.DisplayAlerts = False
newWS.Delete
Application.DisplayAlerts = True
Resume Next
End Sub
Sub listI2()
Dim newWS As Worksheet
Const myWS As String = "listI2"
Dim i As Integer, j As Integer, rowNo As Integer, colNo As Integer
On Error GoTo ErrHandler
Set newWS = Sheets.Add(After:=Worksheets(Worksheets.Count)): newWS.Name = myWS 'add/rename sheet
On Error GoTo 0
presetWS myWS 'clear cells
For i = 1 To 10
Cells(1, i).Value = i * i
Next i
MsgBox ("Cell G1 equals " & Range("G1").Value & vbLf & "Click OK to continue.") '7*7=49
'1 in each cell
For i = 1 To 10
For j = 1 To 10
Cells(i, j).Value = 1
Next j
Next i
MsgBox ("Click OK to continue.")
presetWS myWS 'clear cells
'sum of row number and column number in each cell
For i = 1 To 10
For j = 1 To 10
rowNo = Cells(i, j).Row
colNo = Cells(i, j).Column
Cells(i, j).Value = rowNo + colNo
Next j
Next i
Exit Sub
ErrHandler:
'delete worksheet w/o prompt
Application.DisplayAlerts = False
newWS.Delete
Application.DisplayAlerts = True
Resume Next
End Sub
Sub appOff()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
End Sub
Sub appOn()
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
'Functions
Private Function makechkbrd(myRow As Integer, myCol As Integer, Optional color1 As String = vbBlack, Optional color2 As String = vbWhite)
Dim myRC As Range
If myRow > 64 Or myCol > 64 Then 'max size is 64x64
Exit Function
Else
If myRow Mod 2 <> 0 Then
myRow = myRow + 1
End If
If myCol Mod 2 <> 0 Then
myCol = myCol + 1
End If
End If
'recycle the smallest unit of checkerboard patterns
Set myRC = Application.Union(Cells(1, 1), Cells(2, 2)): myRC.Interior.Color = color1
Set myRC = Application.Union(Cells(1, 2), Cells(2, 1)): myRC.Interior.Color = color2
ActiveSheet.Range("A1:B2").Copy ActiveSheet.Range(Cells(1, 1), Cells(myRow, myCol))
End Function
Private Function formatAllStocksAnalysisTable(Optional myWS As String = "All Stocks Analysis")
Dim i As Integer, rowStart As Integer, rowEnd As Integer
Worksheets(myWS).Activate
Cells(1, 1).Font.Bold = True
With Range(Cells(3, 1), Cells(3, 3))
.Font.Bold = True: .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Range(Cells(4, 2), Cells(15, 2)).NumberFormat = "#,##0": Columns(2).AutoFit
Range(Cells(4, 3), Cells(15, 3)).NumberFormat = "0.0%"
rowStart = 4
rowEnd = Cells(Rows.Count, 1).End(xlUp).Row
For i = rowStart To rowEnd
If Cells(i, 3) > 0 Then
Cells(i, 3).Interior.Color = vbGreen
ElseIf Cells(i, 3) < 0 Then
Cells(i, 3).Interior.Color = vbRed
Else
Cells(i, 3).Interior.Color = xlNone
End If
Next i
End Function
Private Function formatAllStocksAnalysisTableBetter(Optional myWS As String = "All Stocks Analysis")
Dim i As Integer, rowStart As Integer, rowEnd As Integer
Worksheets(myWS).Activate
'Formatting
Cells(1, 1).Font.FontStyle = "Bold"
Range("A3:C3").Font.FontStyle = "Bold"
Range("A3:C3").Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("B4:B15").NumberFormat = "#,##0": Columns(2).AutoFit
Range("C4:C15").NumberFormat = "0.0%"
rowStart = 4
rowEnd = Cells(Rows.Count, 1).End(xlUp).Row 'last non-empty row
For i = rowStart To rowEnd
If Cells(i, 3) > 0 Then
Cells(i, 3).Interior.Color = vbGreen 'Color the cell green
ElseIf Cells(i, 3) < 0 Then
If Cells(i, 3) <= -0.15 Then
Cells(i, 3).Interior.Color = vbRed 'Color the cell red
Else
Cells(i, 3).Interior.Color = vbYellow 'Color the cell yellow
End If
Else
Cells(i, 3).Interior.Color = xlNone 'Clear the cell color
End If
Next i
End Function
Function ClearWorksheet(myWS As String)
Worksheets(myWS).Activate
Cells.Clear 'clear cells
End Function
Private Function presetWS(Optional myWS As String = "chkbrd")
Const myRow = 64, myCol = 64
Worksheets(myWS).Activate
Cells.Clear 'clear cells
Range(Cells(1, 1), Cells(myRow, myCol)).ColumnWidth = Range("A1").RowHeight / 6 'resize column width
End Function