Written by Tushar has a great tutorial on his website. It tells you a lot about regression, trendline and using them in VBA. Check it out!
Trendline coefficients: “Trendline Coefficients and Regression Analysis”
Posts in category Useful Procedures
Random Numbers
Recently, I had the need of generating different types of random numbers. Although, Excel’s Data Analysis Toolpak can generate good random numbers, I had to create these functions to meet my needs.
First: Unique Random Numbers
This function was modified from ozgrid’s RandLotto function, which returns string. This function will return an array of unqiue random integers in the given range. If you want to return more than one number then this function should be entered as an array formula with Ctrl + Shift + Enter.
Function UniqueRand(lngSmallest As Long, lngHighest As Long, HowManyNos As Long) As Long()
‘modified from http://www.ozgrid.com/VBA/RandomNumbers.htm
Dim iArr As Variant
Dim i As Integer
Dim r As Integer
Dim temp As Integer
Application.Volatile
ReDim iArr(lngSmallest To lngHighest)
For i = lngSmallest To lngHighest
iArr(i) = i
Next i
For i = lngHighest To lngSmallest + 1 Step -1
r = Int(Rnd() * (i – lngSmallest + 1)) + lngSmallest
temp = iArr(r)
iArr(r) = iArr(i)
iArr(i) = temp
Next i
Dim resultArr() As Long: ReDim resultArr(HowManyNos – 1, 0)
For i = lngSmallest To lngSmallest + HowManyNos – 1
resultArr(j, 0) = iArr(i)
j = j + 1
Next i
UniqueRand = resultArr
End Function
‘modified from http://www.ozgrid.com/VBA/RandomNumbers.htm
Dim iArr As Variant
Dim i As Integer
Dim r As Integer
Dim temp As Integer
Application.Volatile
ReDim iArr(lngSmallest To lngHighest)
For i = lngSmallest To lngHighest
iArr(i) = i
Next i
For i = lngHighest To lngSmallest + 1 Step -1
r = Int(Rnd() * (i – lngSmallest + 1)) + lngSmallest
temp = iArr(r)
iArr(r) = iArr(i)
iArr(i) = temp
Next i
Dim resultArr() As Long: ReDim resultArr(HowManyNos – 1, 0)
For i = lngSmallest To lngSmallest + HowManyNos – 1
resultArr(j, 0) = iArr(i)
j = j + 1
Next i
UniqueRand = resultArr
End Function
Second: Gaussian or Normal Random Numbers with specified mean and Standard deviation(SD). Now, this function is different than the Analysis toolpak utility because it generates random numbers on a fixed mean and Standard deviation. This function will allow the user to generate random numbers each with different mean and SD.
‘This function will generate Gaussian or Normal Random Numbers based on given mean and SD
Public Function GenGaussNoise(mean As Double, SD As Double, HowMany As Long) As Double()
Dim x As Double, i As Long, j As Long
itr = 50
Dim dblResArr() As Double: ReDim dblResArr(HowMany – 1, 0)
For j = 1 To HowMany
x = 0
For i = 1 To itr
Randomize
U = Rnd
x = x + U
Next i
‘ /* for uniform randoms in [0,1], mu = 0.5 and var = 1/12 */
‘ /* adjust X so mu = 0 and var = 1 */
x = x – itr / 2 ‘ /* set mean to 0 */
x = x * Sqr(12 / itr) ‘ /* adjust variance to 1 */
dblResArr(j – 1, 0) = mean + SD * x
Next j
GenGaussNoise = dblResArr
End Function
Public Function GenGaussNoise(mean As Double, SD As Double, HowMany As Long) As Double()
Dim x As Double, i As Long, j As Long
itr = 50
Dim dblResArr() As Double: ReDim dblResArr(HowMany – 1, 0)
For j = 1 To HowMany
x = 0
For i = 1 To itr
Randomize
U = Rnd
x = x + U
Next i
‘ /* for uniform randoms in [0,1], mu = 0.5 and var = 1/12 */
‘ /* adjust X so mu = 0 and var = 1 */
x = x – itr / 2 ‘ /* set mean to 0 */
x = x * Sqr(12 / itr) ‘ /* adjust variance to 1 */
dblResArr(j – 1, 0) = mean + SD * x
Next j
GenGaussNoise = dblResArr
End Function
Third: Generate white noise or Guassian or Normal random numbers with mean = 0 and SD =1. Although, this could be achieved by the previous function, this function uses Box-Muller method. In this function too, you can use different mean and SD, although if not provided it would take mean =0 and SD=1
Public Function GenWhiteNoise(HowMany As Long, Optional mean As Double = 0, Optional variance As Double = 1) As Double()
‘Returns a normally distributed random variate with mean 0 and variance 1, a.k.a. “White Noise”.
‘ Uses the Box-Muller method
Dim Value1 As Single, Value2 As Single, Fac As Single, Rsq As Single, SD As Double
Dim dblResArr() As Double: ReDim dblResArr(HowMany – 1, 0)
SD = Sqr(variance)
For
pan> i = 1 To HowMany
Do
Randomize
Value1 = 2 * Rnd – 1
Value2 = 2 * Rnd – 1
Rsq = Value1 ^ 2 + Value2 ^ 2
Loop Until Rsq > 0 And Rsq < 1
Fac = (-2 * Log(Rsq) / Rsq) ^ 0.5
If Rnd < 0.5 Then
dblResArr(i – 1, 0) = mean + SD * Value1 * Fac
Else
dblResArr(i – 1, 0) = mean + SD * Value2 * Fac
End If
Next i
GenWhiteNoise = dblResArr
End Function
‘Returns a normally distributed random variate with mean 0 and variance 1, a.k.a. “White Noise”.
‘ Uses the Box-Muller method
Dim Value1 As Single, Value2 As Single, Fac As Single, Rsq As Single, SD As Double
Dim dblResArr() As Double: ReDim dblResArr(HowMany – 1, 0)
SD = Sqr(variance)
For
pan> i = 1 To HowMany
Do
Randomize
Value1 = 2 * Rnd – 1
Value2 = 2 * Rnd – 1
Rsq = Value1 ^ 2 + Value2 ^ 2
Loop Until Rsq > 0 And Rsq < 1
Fac = (-2 * Log(Rsq) / Rsq) ^ 0.5
If Rnd < 0.5 Then
dblResArr(i – 1, 0) = mean + SD * Value1 * Fac
Else
dblResArr(i – 1, 0) = mean + SD * Value2 * Fac
End If
Next i
GenWhiteNoise = dblResArr
End Function
This is a screenshot of the Excel file. Also, the original Excel file can be downloaded here.
Stack Columns of Data on one column
I have modified this code for better explanation and error handling (includes a function to check if a worksheet exists or not). To run this code follow these steps:
1. Insert a new module in your workbook,
2. Copy and paste this code,
3. Go back to worksheet with data in it,
4. Press Alt + F8 to bring the macro window
5. Select this procedure and hit run
6. Enter the new worksheet name in the input box
7. If everything went well, you should have a new worksheet with all the data from original worksheet in one column with the column headers. See the screen shots for example.
Before stacking-the original data:
After stacking:
Here’s the code:
Option Explicit Sub Stack_cols() On Error GoTo Stack_cols_Error Dim lNoofRows As Long, lNoofCols As Long Dim lLoopCounter As Long, lCountRows As Long Dim sNewShtName As String Dim shtOrg As Worksheet, shtNew As Worksheet 'Turn off the screen update to make macro run faster Application.ScreenUpdating = False 'Ask for a new sheet name, if not provided use newsht sNewShtName = InputBox("Enter the new worksheet name", "Enter name", "newsht") 'Set a sheet variable for the sheet where the data resides Set shtOrg = ActiveSheet 'Add a new worksheet, rename it and set it to a variable If Not SheetExists(sNewShtName) Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sNewShtName Set shtNew = Worksheets(sNewShtName) Else MsgBox "Worksheet name exists. Try again", vbInformation, "Sheet Exists" Exit Sub End If With shtOrg 'Get the last column number 'Replace .Range("IV1") with .Range("XFD1") for Excel 2007 lNoofCols = .Range("IV1").End(xlToLeft).Column 'Start a loop to copy and paste data from the first column to the last column For lLoopCounter = 1 To lNoofCols 'Count the number of rows in the looping column 'Replace .Cells(65536, lLoopCounter) with .Cells(1048576, lLoopCounter) for Excel 2007 lNoofRows = .Cells(65536, lLoopCounter).End(xlUp).Row .Range(.Cells(1, lLoopCounter), .Cells(lNoofRows, lLoopCounter)).Copy Destination:=shtNew.Range(shtNew.Cells(lCountRows + 1, 1), shtNew.Cells(lCountRows + lNoofRows, 1)) 'count the number of rows in the new worksheet lCountRows = lCountRows + lNoofRows Next lLoopCounter End With On Error GoTo 0 SmoothExit_Stack_cols: Application.ScreenUpdating = True Exit Sub Stack_cols_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub:Stack_cols" Resume SmoothExit_Stack_cols End Sub 'Check if a worksheet exists or not Public Function SheetExists(sShtName As String) As Boolean On Error Resume Next Dim wsSheet As Worksheet, bResult As Boolean bResult = False Set wsSheet = Sheets(sShtName) On Error GoTo 0 If Not wsSheet Is Nothing Then bResult = True End If SheetExists = bResult End Function
Recent Comments