How to edit incorrect macro formula

15minoffame · Dec 27, 2016

Hi to Excel experts,
I hired someone about two years ago to write a macro for me in Excel. The purpose is to show seasonality in stocks. I discovered too late that he used the incorrect formula in calculating the return of a stock on an annual basis.

I have a tab call Calendar and it looks like this. Each row shows the return of a stock for that particular month in that year.

Stock:

AAPL

Year

JAN

FEB

MAR

APR

MAY

JUN

JUL

AUG

SEP

OCT

NOV

DEC

ANNUAL

W

L

PERCENT

AVG GAIN

STREAK

2016

-7.52%

-0.13%

12.72%

-13.99%

7.18%

-4.27%

9.01%

2.37%

6.55%

11.91%

5

4

55.56%

1.32%

3

2015

6.14%

10.08%

-3.14%

0.58%

4.53%

-3.72%

-3.29%

-6.62%

-2.18%

8.34%

-0.58%

-11.02%

-0.88%

5

7

41.67%

-0.07%

2014

-10.77%

5.75%

2.00%

9.94%

7.87%

2.77%

2.87%

7.75%

-1.71%

7.20%

10.60%

-7.19%

37.08%

9

3

75.00%

3.09%

2013

-14.41%

-2.53%

0.29%

0.03%

2.24%

-11.83%

14.12%

8.38%

-2.15%

9.64%

7.01%

0.89%

11.67%

8

4

66.67%

0.97%

2012

12.71%

18.83%

10.53%

-2.60%

-1.07%

1.09%

4.58%

9.39%

0.28%

-10.76%

-1.24%

-9.07%

32.67%

7

5

58.33%

2.72%

2011

5.20%

4.09%

-1.33%

0.47%

-0.66%

-3.50%

16.33%

-1.45%

-0.91%

6.15%

-5.58%

5.97%

24.78%

6

50.00%

2.06%

2010

-8.86%

6.54%

14.85%

11.10%

-1.61%

-2.08%

2.27%

-5.50%

16.72%

6.07%

3.38%

3.67%

46.55%

8

4

66.67%

3.88%

2009

5.60%

-0.91%

17.70%

19.70%

7.93%

4.87%

14.72%

2.95%

10.19%

1.70%

6.05%

5.41%

95.92%

11

1

91.67%

7.99%

2008

-31.66%

-7.64%

14.78%

21.22%

8.51%

-11.29%

-5.07%

6.66%

-32.96%

-5.34%

-13.87%

-7.90%

-64.56%

4

8

33.33%

-5.38%

2007

1.05%

-1.31%

9.81%

7.42%

21.43%

0.70%

7.97%

5.10%

10.83%

23.77%

-4.07%

8.70%

91.40%

10

2

83.33%

7.62%

2006

5.04%

-9.30%

-8.43%

12.23%

-15.09%

-4.18%

18.67%

-0.16%

13.46%

5.33%

13.05%

-7.44%

23.17%

6

50.00%

1.93%

The formula where the error is in the Annual column. It's supposed to take the last closing price of X day subtract closing price on 12/31 of previous year. Instead, this was the formula he came up with.

If MonthColumn = 13 Or ArrayNum = Counter - 1 Then
Cells(row, 14).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"

I don't know how to edit this to reference the prices in the Annual Prices tab (shown below) which would give me the correct result. These are the year end closing prices for Apple from 2006-2015 and the actual results. As you can see, they're way off due to the incorrect formula used.

2006 11.10 18.01%
2007 25.91 133.47%
2008 11.16 -56.91%
2009 27.56 146.90%
2010 42.19 53.07%
2011 52.97 25.56%
2012 70.22 32.57%
2013 75.89 8.07%
2014 106.71 40.62%
2015 103.50 -3.01%

Thanks for ANY suggestions!

Tuan

Marcelo Branco · Dec 27, 2016

Hard to suggest anything without the whole scenario

Just a guess...(try it on a copy of your workbook)

Code:

ActiveCell.FormulaR1C1 = "=SUMPRODUCT(PRODUCT(1+RC[-12]:RC[-1]))-1"

Hope this helps

M.

15minoffame · Dec 27, 2016

Hi Marcelo,
Thank you for your response but that code didn't work. Here's his entire code for the Calendar tab. Hope this helps. Please let me know if you need another set of codes under the Annual Prices or Annual Summary tabs too.

Option Explicit

Sub UpdateCalendars()
'this sub automatically updates the calendar return for the entered stock

Application.StatusBar = "Finding the desired symbol and saving the summary return data..."

Sheets("Calendar").Activate
Dim w1 As Worksheet: Set w1 = ActiveSheet
'Dim w2 As Worksheet: Set w2 = ThisWorkbook.Worksheets("Weekly Summary")
Dim w3 As Worksheet: Set w3 = ThisWorkbook.Worksheets("Monthly Summary")

'clear all old calendar data and remove previous borders
Range("A4:S4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Range("A3:S3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A3").Select

'Turn off screen updating
Application.ScreenUpdating = False

'get desired Symbol and find on the summary sheets
Dim Symbol As String: Symbol = w1.Range("B1").Value

w3.Activate
On Error Resume Next
w3.ShowAllData
Dim EndColumn As Integer: EndColumn = Range("D15").End(xlToRight).column
Dim EndRow As Integer: EndRow = Range("A15").End(xlDown).row
Dim NumDates As Integer: NumDates = EndRow - 15
Dim row, column, StockColumn As Integer

'loop through stocks and find the desired symbol
StockColumn = 0
For column = 4 To EndColumn
Cells(15, column).Select
If Selection.Value = Symbol Then
StockColumn = column
Exit For
End If
Next column

If StockColumn = 0 Then
w1.Activate
Range("B1").Select
MsgBox "The entered symbol was not found on the summary sheet."
Exit Sub
End If

Application.StatusBar = "Found symbol. Saving data to the calendar format..."

'loop through data and save returns for desired symbol
Dim Dates() As Date
ReDim Dates(NumDates) As Date
Dim Returns() As Single
ReDim Returns(NumDates) As Single
Dim Counter As Integer: Counter = 0
Dim CurrentYear As Integer

For row = 16 To EndRow
Dates(Counter) = Cells(row, 1).Value
Returns(Counter) = Cells(row, StockColumn).Value
Counter = Counter + 1
Next row

'save data to the calendar
w1.Activate
Dim ArrayNum, MonthColumn As Integer
row = 4
Dim Percent As Integer

For ArrayNum = 0 To Counter - 1

'output year
CurrentYear = Year(Dates(ArrayNum))
Cells(row, 1).Value = CurrentYear
MonthColumn = Month(Dates(ArrayNum)) + 1
'output return
Cells(row, MonthColumn).Value = Application.WorksheetFunction.Round(Returns(ArrayNum), 5)
'check if month is Dec (or last data point), if so calculate year's metrics and update the row variable
If MonthColumn = 13 Or ArrayNum = Counter - 1 Then
Cells(row, 14).Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(PRODUCT(1+RC[-12]:RC[-1]))-1"
Cells(row, 15).Select
ActiveCell.FormulaR1C1 = "=COUNTIF(RC[-13]:RC[-2],"">= 0"")"
Cells(row, 16).Select
ActiveCell.FormulaR1C1 = "=COUNTIF(RC[-14]:RC[-3],""< 0"")"
Cells(row, 17).Select
ActiveCell.FormulaR1C1 = "=RC[-2]/SUM(RC[-2]:RC[-1])"

Cells(row, 18).Select
ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-16]:RC[-5])"
row = row + 1
End If

Percent = 100 * (ArrayNum + 1) / Counter
Application.StatusBar = "Saved " & ArrayNum + 1 & " of " & Counter & " returns for " & Symbol & "..." & Percent & " % complete"

Next ArrayNum

Application.StatusBar = "Calculating the current monthly streak for " & Symbol
'calculate the current monthly streak
Dim Streak As Integer
Dim Positive As Boolean

For ArrayNum = Counter - 1 To 0 Step -1

If ArrayNum = Counter - 1 Then
'first return, set positive boolean value
If Returns(ArrayNum) >= 0 Then
Positive = True
Streak = 1
Else
Positive = False
Streak = -1
End If
Else
'not first return, see if streak continues or not
If Returns(ArrayNum) >= 0 And Positive = True Then
'win streak continues
Streak = Streak + 1
ElseIf Returns(ArrayNum) < 0 And Positive = False Then
'loss streak continues
Streak = Streak - 1
Else
'streak is broken, end for loop
Exit For
End If
End If

Next ArrayNum

'add borders to the table
Range(Cells(3, 1), Cells(row - 1, 19)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A3").Select

'sort table by the newest data
Range(Cells(3, 1), Cells(row - 1, 19)).Select
ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range("A4:A" & row - 1) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Calendar").Sort
.SetRange Range(Cells(3, 1), Cells(row - 1, 19))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3").Select

'add formats for positive numbers to be green / negative red
Cells.FormatConditions.Delete

Range(Cells(4, 2), Cells(row - 1, 14)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = False
.Italic = False
.Color = -11489280
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Range(Cells(4, 2), Cells(row - 1, 14)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = False
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

'put current streak in cell S4
Range("S4").Value = Streak

Range("A3").Select
Application.StatusBar = False

End Sub

Marcelo Branco · Dec 27, 2016

Hi

Maybe i have not understood what you need, but the code worked perfectly for me using your data sample above

Something like this (comma as decimal separator)

Before Macro

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Year	JAN	FEB	MAR	APR	MAY	JUN	JUL	AUG	SEP	OCT	NOV	DEC	ANNUAL
2	2016	-7,52%	-0,13%	12,72%	-13,99%	7,18%	-4,27%	9,01%	2,37%	6,55%
3	2015	6,14%	10,08%	-3,14%	0,58%	4,53%	-3,72%	-3,29%	-6,62%	-2,18%	8,34%	-0,58%	-11,02%
4	2014	-10,77%	5,75%	2,00%	9,94%	7,87%	2,77%	2,87%	7,75%	-1,71%	7,20%	10,60%	-7,19%
5	2013	-14,41%	-2,53%	0,29%	0,03%	2,24%	-11,83%	14,12%	8,38%	-2,15%	9,64%	7,01%	0,89%
6	2012	12,71%	18,83%	10,53%	-2,60%	-1,07%	1,09%	4,58%	9,39%	0,28%	-10,76%	-1,24%	-9,07%
7	2011	5,20%	4,09%	-1,33%	0,47%	-0,66%	-3,50%	16,33%	-1,45%	-0,91%	6,15%	-5,58%	5,97%
8	2010	-8,86%	6,54%	14,85%	11,10%	-1,61%	-2,08%	2,27%	-5,50%	16,72%	6,07%	3,38%	3,67%
9	2009	5,60%	-0,91%	17,70%	19,70%	7,93%	4,87%	14,72%	2,95%	10,19%	1,70%	6,05%	5,41%
10	2008	-31,66%	-7,64%	14,78%	21,22%	8,51%	-11,29%	-5,07%	6,66%	-32,96%	-5,34%	-13,87%	-7,90%
11	2007	1,05%	-1,31%	9,81%	7,42%	21,43%	0,70%	7,97%	5,10%	10,83%	23,77%	-4,07%	8,70%
12	2006	5,04%	-9,30%	-8,43%	12,23%	-15,09%	-4,18%	18,67%	-0,16%	13,46%	5,33%	13,05%	-7,44%

Simple code to just insert the formula in N2:N13 to calculate the annual variation

Code:

Sub aTest()
    Dim i As Long
    
    'Activate the first cell
    Range("N2").Activate
    
    'Loop to insert the formula in N2:N13
    For i = 2 To 12
        ActiveCell.FormulaR1C1 = "=SUMPRODUCT(PRODUCT(1+RC[-12]:RC[-1]))-1"
        ActiveCell.Offset(1).Activate
    Next i
    
End Sub

After macro (observe the gray area with the desired results)

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Year	JAN	FEB	MAR	APR	MAY	JUN	JUL	AUG	SEP	OCT	NOV	DEC	ANNUAL
2	2016	-7,52%	-0,13%	12,72%	-13,99%	7,18%	-4,27%	9,01%	2,37%	6,55%				9,24%
3	2015	6,14%	10,08%	-3,14%	0,58%	4,53%	-3,72%	-3,29%	-6,62%	-2,18%	8,34%	-0,58%	-11,02%	-3,01%
4	2014	-10,77%	5,75%	2,00%	9,94%	7,87%	2,77%	2,87%	7,75%	-1,71%	7,20%	10,60%	-7,19%	40,63%
5	2013	-14,41%	-2,53%	0,29%	0,03%	2,24%	-11,83%	14,12%	8,38%	-2,15%	9,64%	7,01%	0,89%	8,08%
6	2012	12,71%	18,83%	10,53%	-2,60%	-1,07%	1,09%	4,58%	9,39%	0,28%	-10,76%	-1,24%	-9,07%	32,57%
7	2011	5,20%	4,09%	-1,33%	0,47%	-0,66%	-3,50%	16,33%	-1,45%	-0,91%	6,15%	-5,58%	5,97%	25,56%
8	2010	-8,86%	6,54%	14,85%	11,10%	-1,61%	-2,08%	2,27%	-5,50%	16,72%	6,07%	3,38%	3,67%	53,07%
9	2009	5,60%	-0,91%	17,70%	19,70%	7,93%	4,87%	14,72%	2,95%	10,19%	1,70%	6,05%	5,41%	146,88%
10	2008	-31,66%	-7,64%	14,78%	21,22%	8,51%	-11,29%	-5,07%	6,66%	-32,96%	-5,34%	-13,87%	-7,90%	-56,91%
11	2007	1,05%	-1,31%	9,81%	7,42%	21,43%	0,70%	7,97%	5,10%	10,83%	23,77%	-4,07%	8,70%	133,48%
12	2006	5,04%	-9,30%	-8,43%	12,23%	-15,09%	-4,18%	18,67%	-0,16%	13,46%	5,33%	13,05%	-7,44%	18,02%

REMARK: How the formula works?
We have the monthly price changes, either positive or negative (up or down) in the 12 columns on the left. So the formula, first, adds 1 to each of these values and then the PRODUCT function calculates the annual change by multiplying all these values.

SUMPRODUCT is needed to generate the array
{Jan_value + 1, Feb_value + 1, ...., Dec_value + 1}
that is passed, as the argument, to the PRODUCT function.

Hope i made myself clear

M.

15minoffame · Dec 27, 2016

I'm sorry, I was somehow looking at it wrong. It works! You are an Excel genius! His codes doesn't give me the running total for the current month, but instead the results stop at the previous month. Would you know the code to do this and if so, where would I insert it in the Macro?

Thank you so much again!

Marcelo Branco · Dec 27, 2016

You are welcome. Glad to help

M.
ps: about your question:
This is a large and complex macro and I've already taken my chances suggesting a change. I do not know if I should abuse of my luck.

BTW, what exactly do you mean by
'His codes doesn't give me the running total for the current month, but instead the results stop at the previous month."

15minoffame · Dec 28, 2016

The macro doesn't give me the result of the current month. It only goes through the previous month. I would like it to give me the total for the current month which in this case is December so that it can also update the Annual too. Right now, Annual total is always lagging one month behind.

Year	JAN	FEB	MAR	APR	MAY	JUN	JUL	AUG	SEP	OCT	NOV	DEC	ANNUAL	W	L	PERCENT	AVG GAIN	STREAK
2016	-11.14%	7.46%	13.62%	-0.28%	31.84%	0.62%	21.46%	7.62%	11.71%	3.85%	29.76%		182.42%	9	2	81.82%	10.59%	7
2015	-4.24%	15.34%	-5.12%	6.07%	0.15%	-9.13%	-0.80%	13.16%	9.65%	15.09%	12.23%	3.91%	67.12%	8	4	66.67%	4.69%
2014	-2.00%	17.60%	-2.56%	3.13%	3.34%	-2.42%	-5.61%	11.64%	-5.14%	5.91%	7.77%	-4.39%	27.40%	6	6	50.00%	2.27%
2013	0.00%	3.90%	1.34%	7.33%	5.62%	-2.97%	2.85%	2.66%	5.49%	-2.38%	3.26%	2.69%	33.52%	10	2	83.33%	2.48%
2012	6.57%	2.57%	1.65%	-15.58%	-4.39%	11.18%	-2.03%	3.62%	-4.92%	-10.20%	0.56%	2.42%	-10.97%	7	5	58.33%	-0.71%
2011	55.33%	-5.27%	-18.54%	8.34%	0.20%	-20.46%	-13.24%	-3.76%	-6.01%	18.31%	5.61%	-11.32%	-10.00%	5	7	41.67%	0.77%
2010	-17.61%	5.26%	7.41%	-9.71%	-16.36%	-22.30%	-9.99%	1.52%	25.19%	2.91%	13.23%	13.15%	-17.56%	7	5	58.33%	-0.61%
2009	-1.49%	4.15%	19.08%	16.43%	-9.15%	8.25%	14.53%	12.30%	3.51%	-20.43%	9.20%	43.03%	131.47%	9	3	75.00%	8.28%
2008	-27.72%	-13.01%	-7.48%	3.84%	20.20%	-24.21%	-38.89%	10.49%	-15.27%	-18.21%	-14.73%	8.03%	-76.28%	4	8	33.33%	-9.75%
2007	-17.19%	1.14%	-7.16%	14.28%	5.32%	19.26%	10.77%	11.80%	6.26%	-2.37%	-10.85%	7.86%	37.88%	8	4	66.67%	3.26%
2006												0.05%	0.05%	1	0	100.00%	0.05%

Marcelo Branco · Dec 28, 2016

It seems that we are talking about a complex project - the macro you have showed above certainly is just a piece of a such project.
Sorry, i cannot help you. I think you should hire a pro to review or remake everything.

M.

15minoffame · Dec 28, 2016

Understood. You've been more than helpful. That was a big glitch that has been bothering me. I was hoping if you think you could help me with just one more glitch. I can run results with this sheet on an Annual, Monthly or Weekly basis. In other words, lets say I want to know what stocks have historically fared the best during the first week in January over X amount of years. The glitch is when there is a week where the return was 0%, the formula counts it as a Win and a Loss when it should count it as only a win. This in turns give the final results more than the total months.

I've shown an example below. This query was ran over the past ten years but since MTG had a 0% week, it added to both the Win & Loss column giving the W-L record as 7-4, when it should be 7-3.

Stock List	W	L	Percent	Avg Gain	Streak	0<1%	1<3%	3<5%	5<7%	7<9%	10%+
KATE	8	2	80.00%	4.64%	5	1	1	1	2	0	3
BBRY	8	2	80.00%	2.12%	1	1	3	1	2	0	1
ALXN	8	2	80.00%	1.52%	1	4	1	2	1	0	0
CF	8	2	80.00%	3.17%	-1	1	3	1	1	1	1
AGN	7	3	70.00%	0.77%	3	2	3	1	1	0	0
WTW	7	3	70.00%	4.60%	1	3	0	1	0	0	3
CRM	7	3	70.00%	1.97%	1	1	2	1	0	3	0
GOOGL	7	3	70.00%	1.46%	1	2	1	1	3	0	0
MTG	7	4	63.64%	5.94%	-1	1	1	1	0	0	3
VRX	7	3	70.00%	3.34%	-1	0	3	2	0	0	2
XBI	7	3	70.00%	1.46%	-1	2	3	1	0	1	0
CELG	7	3	70.00%	1.29%	-1	4	0	1	2	0	0
RAD	7	3	70.00%	1.07%	-1	0	2	2	1	1	1
WBMD	7	3	70.00%	1.92%	-2	3	1	1	0	2	0
GLW	7	3	70.00%	1.32%	-2	3	2	1	0	0	1

I'm hoping you can find the formula in this macro to correct it. Thanks again if you can help.

Option Explicit

Sub UpdateTable()
'this sub automatically filters the weekly or monthly summaries based upon the user inputs, then copies the summary data to the Main sheet table

Application.ScreenUpdating = False

Sheets("Main").Activate
Dim w1 As Worksheet: Set w1 = ActiveSheet

'clear all old summary data and remove previous borders
Dim i, NumStocks As Integer: NumStocks = Range("A4").End(xlDown).row - 4
Range(Cells(5, 2), Cells(NumStocks + 4, 12)).Select
Selection.ClearContents

Range("A4:M4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

On Error Resume Next
w1.ShowAllData

'sort data by the initial stock order
Range("A4:M" & NumStocks + 4).Select
ActiveWorkbook.Worksheets("Main").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Main").Sort.SortFields.Add Key:=Range("M5:M" & NumStocks + 4), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Main").Sort
.SetRange Range("A4:M" & NumStocks + 4)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Turn off screen updating
Application.ScreenUpdating = False

'determine what data type / sheet to get summary for (set as w2)
Dim DataType As String: DataType = Range("E1").Value
Dim w2 As Worksheet
Dim Month As Integer
Dim WeekNum As Integer

If DataType = "Weekly" Then
Set w2 = ThisWorkbook.Worksheets("Weekly Summary")
WeekNum = Range("K1").Value
If WeekNum < 1 Or WeekNum > 4 Then
MsgBox "The data entered for the week number in cell K1 is not valid."
Range("K1").Select
Exit Sub
End If
ElseIf DataType = "Monthly" Then
Set w2 = ThisWorkbook.Worksheets("Monthly Summary")
'clear week num entry
Range("K1").Value = ""
Month = Range("H2").Value
If Month < 1 Or Month > 12 Then
MsgBox "The data entered for the month in cell H1 is not valid."
Range("H1").Select
Exit Sub
End If
ElseIf DataType = "Annual" Then
Set w2 = ThisWorkbook.Worksheets("Annual Summary")
'clear month and week num entry
Range("H1").Value = ""
Range("K1").Value = ""
Else
'error
MsgBox "The data type entered into cell E1 is not valid."
Exit Sub
End If
Month = Range("H2").Value

'go to the summary sheet and unfilter the results
w2.Activate
On Error Resume Next
w2.ShowAllData

'get the last row and column
Dim LastRow As Integer: LastRow = w2.Range("A15").End(xlDown).row
Dim EndColumn As Integer: EndColumn = w2.Range("D15").End(xlToRight).column

'filter the data as desired
If DataType = "Weekly" Then
ActiveSheet.Range("$A$15:$C$" & LastRow).AutoFilter Field:=2, Criteria1:=Month
ActiveSheet.Range("$A$15:$C$" & LastRow).AutoFilter Field:=3, Criteria1:=WeekNum
ElseIf DataType = "Monthly" Then
ActiveSheet.Range("$A$15:$B$" & LastRow).AutoFilter Field:=2, Criteria1:=Month
ElseIf DataType = "Annal" Then
'no filter required
Else
'error would've occured at first datatype check
End If

'recalculate the current streaks
Call UpdateStreak

'copy summary data
Range(Cells(3, 4), Cells(13, EndColumn)).Select
Selection.Copy

'paste summary data to main sheet table
w1.Activate
w1.Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

'add borders to the table
Range(Cells(4, 1), Cells(NumStocks + 4, 12)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A3").Select

'move the streak data to be just after the avg gain
Range("L5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("F5").Select
Selection.Insert Shift:=xlToRight

Range("B5").Select

End Sub

Marcelo Branco · Dec 28, 2016

I'm afraid i cannot help you...
1. Don't understand the logic to calculate columns W and L
For example, why 8 -2 for Kate or 7-3 for MTG?

2. I cannot see any formula in the macro above.

M.

How to edit incorrect macro formula

15minoffame

Board Regular

Excel Facts

Marcelo Branco

MrExcel MVP

15minoffame

Board Regular

Marcelo Branco

MrExcel MVP

15minoffame

Board Regular

Marcelo Branco

MrExcel MVP

15minoffame

Board Regular

Marcelo Branco

MrExcel MVP

15minoffame

Board Regular

Marcelo Branco

MrExcel MVP

Forum statistics

Share this page

How to edit incorrect macro formula

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock