Arrays in VBA

Sub DeclaringArrays()

'Declare Array with range 0,1,2,3

Dim MyArray(0 To 3) As Variant

'Declare Array with range 0,1,2,3

Dim MyArray(3) As Variant

'Declare Array with range 1,2,3

Dim MyArray(1 To 3) As Variant

'Declare Array with range 2,3,4

Dim MyArray(2 To 4) As Variant

'DYNAMIC ARRAYS

'Declare Array with Dynamic Range

Dim MyArray() As Variant

'Resize Array with range 0,1,2,3,4

ReDim MyArray(0 To 4)

'ASSIGN VALUES TO AN ARRAY

MyArray(0) = 100

MyArray(1) = 200

MyArray(2) = 300

MyArray(3) = 400

MyArray(4) = 500

MyArray(5) = 600 '<<< Will Return an error because there is not 5th element.

'LOOP THROUGH ARRAYS

'Using For Loop

Dim i As Long

For i = LBound(MyArray) To UBound(MyArray)

Debug.Print MyArray(i)

Next

'Using For Each Loop

Dim Elem As Variant

For Each Elem In MyArray

Debug.Print Elem

Next

'USE ERASE

'Declare Static Array

Dim MyArray(0 To 3) As Long

Erase MyArray '<<< All Values will be set to 0.

'Declare Dynamic Array

Dim MyArray() As Long

ReDim MyArray(0 To 3)

Erase MyArray '<<< Array is erased from memory.

'USE REDIM

Dim MyArray() As Variant

MyArray(0) = "MyFirstElement"

'Old Array with "MyFirstElement" is now deleted.

ReDim MyArray(0 To 4)

Dim MyArray() As Variant

MyArray(0) = "MyFirstElement"

'Old Array with "MyFirstElement" is now Resized With Original Content Kept in Place.

ReDim Preserve MyArray(0 To 4)

'USING MULTIDIMENSIONAL ARRAYS

'Declare two dimensional array

Dim MultiDimArray(0 To 3, 0 To 3) As Integer

Dim i, j As Integer

'Assign values to array

For i = LBound(MultiDimArray, 1) To UBound(MultiDimArray, 1)

For j = LBound(MultiDimArray, 2) To UBound(MultiDimArray, 2)

MultiDimArray(i, j) = i + j

Next j

Next i

'Print values from array.

For i = LBound(MultiDimArray, 1) To UBound(MultiDimArray, 1)

For j = LBound(MultiDimArray, 2) To UBound(MultiDimArray, 2)

Debug.Print MultiDimArray(i, j)

Next j

Next i

End Sub

Attribute VB_Name = "Arrays"

Offset in VBA

Sub OffsetActiveCell()

'Go 5 rows below & 4 columns to the left

ActiveCell.Offset(5, -4).Select

'Go 2 rows above & 3 columns to the right

ActiveCell.Offset(-2, 3).Select

'Error occurs if the row you're selecting is off the sheet.

End Sub

Sub OffsetCell()

'Go 5 rows below & 4 columns to the right

ActiveSheet.Cells(7, 3).Offset(5, 4).Select

'Go 5 rows below & 4 columns to the right

ActiveSheet.Range("C7").Offset(5, 4).Select

End Sub

Sub OffsetRangeOfCell()

'Go 4 rows below & 3 columns to the right - MAINTAING THE SAME RANGE SIZE

ActiveSheet.Range("Test").Offset(4, 3).Select

'Long handed way

'Go 4 rows below & 3 columns to the right - MAINTAING THE SAME RANGE SIZE

Sheets("Sheet2").Activate

ActiveSheet.Range("Test").Offset(4, 3).Select

End Sub

Sub ResizeSelection()

'Select the range

Range("Test").Select

'Resize the selection by five rows

Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select

End Sub

Sub ResizeSelectionOffset()

'Select the range

Range("Test").Select

'Offset and then resize the selection by five rows

Selection.Offset(4, 3).Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select

End Sub

Sub SelectUnionOfTwoOrMoreRanges()

Application.Union(Range("Test"), Range("Sample")).Select

'DOES NOT WORK ACROSS SHEETS

Set y = Application.Union(Range("Sheet1!A1:B2"), Range("Sheet1!C3:D4"))

Set y = Application.Union(Range("Sheet1!A1:B2"), Range("Sheet2!C3:D4"))

End Sub

Sub SelectIntersection()

'DOES NOT WORK ACROSS SHEETS

Application.Intersect(Range("Test"), Range("Sample")).Select

End Sub

Attribute VB_Name = "Offset"

Excel trick,find common digit between two number in two different cells

I have 7899 in A1 and 567 in B2

in E1 I am getting the mode 7

the formula is

=MODE(VALUE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)),VALUE(MID(B1,ROW(INDIRECT("1:"&LEN(B1))),1)))

it's an array formula so you have to use ctrl+shift+enter

Selecting range example in VBA

Sub SelectingLastCellOfContiguousRange()

'Go To last cell

ActiveSheet.Range("a1").End(xlDown).Select

End Sub

Sub SelectingBlankCellOfContiguousRange()

'Go to first blank cell after laste cell

ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select

End Sub

Sub SelectEntireRangeofContiguousCells()

'Select Range Of Cells No Blanks

ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown)).Select

ActiveSheet.Range("a1:" & ActiveSheet.Range("a1").End(xlDown).Address).Select

End Sub

Sub SelectEntireRangeofNonContiguousCells()

'Select Range of Cells That Includes Blanks

ActiveSheet.Range("a1", ActiveSheet.Range("a65536").End(xlUp)).Select

ActiveSheet.Range("a1:" & ActiveSheet.Range("a65536").End(xlUp).Address).Select

End Sub

Sub SelectEntire()

'Select Entire Row

Range("1:1").Select

'Select Entire Column

Range("A:A").Select

End Sub

Sub SelectRectangularRange()

'Select Current Region

'ActiveSheet.Range("a1").CurrentRegion.Select

'ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown).End(xlToRight)).Select

'ActiveSheet.Range("a1:" & ActiveSheet.Range("a1").End(xlDown).End(xlToRight).Address).Select

'Build Current Region

lastCol = ActiveSheet.Range("a1").End(xlToRight).Column

lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row

ActiveSheet.Range("a1", ActiveSheet.Cells(lastRow, lastCol)).Select

'Including a blank row

lastCol = ActiveSheet.Range("a1").End(xlToRight).Column

lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row

ActiveSheet.Range("a1:" & ActiveSheet.Cells(lastRow, lastCol).Address).Select

End Sub

Sub SelectMultiNonContColumns()

StartRange = "A1"

EndRange = "C1"

Set a = Range(StartRange, Range(StartRange).End(xlDown))

Set b = Range(EndRange, Range(EndRange).End(xlDown))

Union(a, b).Select

End Sub

Attribute VB_Name = "SelectingLast"

VBA Macro to run linear regression between two variables,VBA Teacher Sourav,Kolkata 08910141720

I have observations for two variable ,the column speed is for X variable,The column distance is for Y variable

Now I have Data Analysis toolpack installed,so this macro will calculate linear regression for X and Y

Sub automatelinearregression()
Sheets("Sheet1").Select

lrA = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox (lrA)

lrC = Cells(Rows.Count, "B").End(xlUp).Row
MsgBox (lrC)
lr = Application.Max(lrA, lrC)  'or Min? I expect the x and y have to have the same number of values?
MsgBox (lr)
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("B1:B" & lr), ActiveSheet.Range("A1:A" & lr), False, True, 95, ActiveSheet.Range("$O$5"), False, False, False, False, , False
End Sub

Result:

Source:http://www.vbaexpress.com/forum/showthread.php?55218-VBA-to-run-a-Linear-Regression-Automatically