# Simple Regression Using Gradient Descent (in VBA)

#### wellinth

##### Board Regular
Gradient descent finds the minimum of a function. It's used in machine learning a lot. I created an Excel macro that uses it find the slope and intercept of a trend line. (The macro uses an algorithm found in Learn under the hood of Gradient Descent algorithm using excel.) See below for the code. If anyone wants, I can send him/her an Excel file that implements this macro.

Hope this helps.

- Tom

VBA Code:
``````Option Explicit

'Uses gradient descent to estimate the slope and intercept in simple regression
On Error GoTo Err_Handler

Dim xRange As Range, yRange As Range
Dim numxvals As Integer, numyvals As Integer
Dim slope As Double, intercept As Double
Dim cost_function As Double, partial_slope As Double, partial_intercept As Double
Dim maxiter As Integer, tol As Double, alpha As Double
Dim predicted_Ys As Variant, j As Integer, iter As Integer
Dim resid As Double

'Get range of data for regression.  If ranges not compatible or missing
'exit with error

'On Error Resume Next
Set xRange = Application.InputBox(prompt:="Enter x range.", Type:=8)
'On Error GoTo 0

If xRange Is Nothing Then
MsgBox "Nothing Entered.  Operation Cancelled", vbExclamation
Exit Sub
End If

Set yRange = Application.InputBox(prompt:="Enter y range.", Type:=8)

If yRange Is Nothing Then
MsgBox "Nothing Entered.  Operation Cancelled", vbExclamation
Exit Sub
End If

'number of data points.
numxvals = xRange.Rows.Count
numyvals = yRange.Rows.Count

If numxvals <> numyvals Then
MsgBox "x Range and y Range have Different numbers.  Try Again.", vbExclamation
GoTo Clean_Up_and_Exit
End If

If yRange.Columns.Count > 1 Then
MsgBox "y Range must be one column!  Try Again.", vbExclamation
GoTo Clean_Up_and_Exit
End If

'Clear ranges.
'Create an array to hold predicted y-values at each iteration.
Range("P:U").Clear

ReDim predicted_Ys(1 To numyvals)

slope = Range("O1").Value
intercept = Range("O2").Value
maxiter = Range("O3").Value
tol = Range("O4").Value
alpha = Range("O5").Value

'Calculate the initial predited values, cost function and partial derivatives of slope and intercept

iter = 1
cost_function = 0
partial_intercept = 0
partial_slope = 0

For j = 1 To numyvals

predicted_Ys(j) = intercept + (slope * xRange.Cells(j, 1).Value)
resid = yRange.Cells(j, 1).Value - predicted_Ys(j)
cost_function = cost_function + resid * resid
partial_intercept = partial_intercept - resid
partial_slope = partial_slope - resid * xRange.Cells(j, 1).Value

Next j

cost_function = cost_function / 2

'Use the partials to restimate the slope and intercept at each iteration.  Print intermediate results.
'stop after maximum number of iterations reached or cost function error is within the desired tolerance.

Range("P1").Value = "Iteration"
Range("Q1").Value = "Slope of Regression Line"
Range("R1").Value = "Intercept of Regression Line"
Range("S1").Value = "Value of Cost Function"
Range("T1").Value = "Partial of Intercept"
Range("U1").Value = "Partial of Slope"

Do

Range("P1").Offset(iter, 0).Value = iter
Range("Q1").Offset(iter, 0).Value = slope
Range("R1").Offset(iter, 0).Value = intercept
Range("S1").Offset(iter, 0).Value = cost_function
Range("T1").Offset(iter, 0).Value = partial_intercept
Range("U1").Offset(iter, 0).Value = partial_slope

intercept = intercept - alpha * partial_intercept
slope = slope - alpha * partial_slope

iter = iter + 1
cost_function = 0
partial_intercept = 0
partial_slope = 0

For j = 1 To numyvals

predicted_Ys(j) = intercept + slope * xRange.Cells(j, 1).Value
resid = yRange.Cells(j, 1).Value - predicted_Ys(j)
cost_function = resid * resid + cost_function

partial_intercept = partial_intercept - resid
partial_slope = partial_slope - resid * xRange.Cells(j, 1).Value

Next j

cost_function = cost_function / 2

Loop Until (cost_function <= tol Or iter > maxiter)

'Print final result and exit.
Range("N14").Value = "Estimated Slope:  " & slope
Range("N15").Value = "Estimated Intercept:  " & intercept

Clean_Up_and_Exit:
Set xRange = Nothing
Set yRange = Nothing
Exit Sub

Err_Handler:
If Err.Number = 424 Then
MsgBox prompt:="Hmmm... Something went wrong. Maybe you clicked cancel by mistake ", _
Title:="Try Again"
Else
MsgBox prompt:="Hmmm... Something went wrong." & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description, _
Title:="Try Again"

End If

GoTo Clean_Up_and_Exit

End Sub``````

### Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Replies
0
Views
88
Replies
5
Views
128
Replies
1
Views
197
Replies
6
Views
143
Replies
4
Views
242

1,127,522
Messages
5,625,301
Members
416,089
Latest member
Captkraken33

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back