User Rating: 5 / 5

Star ActiveStar ActiveStar ActiveStar ActiveStar Active
 

 

Excel VBA Arrays: Declaring Arrays, One-Dimensional and Multi-Dimensional Arrays, Fixed-Size and Dynamic Arrays, ReDim Statement, Lower Bound and Upper Bound, Array Size, Create a 200-Year Calendar with Excel VBA, ParamArray  (Parameter Array)

 

----------------------------------------------------------------------------------------------------------------------------

Contents:

VBA Arrays

Declare Arrays, Sizing an Array, Determining the Upper and Lower Bounds

One-Dimensional and Multi-Dimensional Arrays

Fixed-size and Dynamic Arrays; ReDim Statement to Resize Dynamic Array

Excel VBA Functions: SPLIT a String and return an Array of Substrings; JOIN an Array of Substrings to form a String

Create a 200-Year Calendar in VBA, using Arrays with Loops

ParamArray (Parameter Array)

 ----------------------------------------------------------------------------------------------------------------------------

 

VBA Arrays

 

An array is a set or collection of variables (referred as elements) having the same data type and name. Note that if the data type is Variant, each element may consist of a different type of data viz. String, Number, etc. If you work with a list of items of similar data type, say 20 numbers, then instead of declaring each item as a separate variable, you can declare them as only one array of variables. VBA allows to refer them with the same name and treats them as a single variable. The individual items in an array are referred to as elements and their respective index values (or subscript) would be 0, 1, 2, and so on.

 

 

 

Declare Arrays, Sizing an Array, Determining the Upper and Lower Bounds

 

To declare an array (ie. using  Dim statement), it is necessary to provide the upper bound (which is the last or largest index number), while the lower bound (which is the first or smallest index number) is optional. If you do not mention the lower bound, it is determined by the Option Base setting for the module, which by default is 0. You can specify Option Base 1 in the Declarations section of the module (ie. outside the sub procedure) and then index will start from 1. This will mean that respective index values of an array with 3 elements will be 1, 2 and 3. Not entering Option Base 1 will mean index values of 0, 1 and 2. Note: The lower bound and upper bound of a dimension are integers; the index or subscript along the dimension will be an integer between both or equal to either; the array length along the dimension is equal to "upper bound minus lower bound plus 1". The size of an array is the total number of elements which is determined by the product of its dimensions.

 

Determine Upper and Lower Bounds:

 

The LBOUND and UBOUND Functions determine the Lower Bound and Upper Bound respectively, for an array. When using these functions for a multi-dimensional array, specify the dimension for which the Lower Bound or Upper Bound are to be determined.

 

 

Examples:

 

One-Dimensional Array: Dim myArray1(5) As String

Determine: VBA Function / Formula Result
Lower Bound LBound(myArray1) 0
Upper Bound UBound(myArray1) 5
Array Size UBound(myArray1) - LBound(myArray1) + 1 6

 

 

One-Dimensional Array: Dim myArray2(-3 To 7) As String

Lower Bound LBound(myArray2) -3
Upper Bound UBound(myArray2) 7
Array Size UBound(myArray2) - LBound(myArray2) + 1 11

 

 

Three-Dimensional Array: Dim myArray3(15, 0 To 20, 100 To 500) As Long

Dimension 1:    
Lower Bound LBound(myArray3, 1) 0
Upper Bound UBound(myArray3, 1) 15
Size UBound(myArray3, 1) - LBound(myArray3, 1) + 1 16
Dimension 2:    
Lower Bound LBound(myArray3, 2) 0
Upper Bound UBound(myArray3, 2) 20
Size UBound(myArray3, 2) - LBound(myArray3, 2) + 1 21
Dimension 3:    
Lower Bound LBound(myArray3, 3) 100
Upper Bound UBound(myArray3, 3) 500
Size UBound(myArray3, 3) - LBound(myArray3, 3) + 1 401
Array Size =16*21*401 134736

 

 

 

One-Dimensional and Multi-Dimensional Arrays

 

One-dimensional array:

 

One-dimensional array is a list of items having a single row or a single column, example, Quarterly Sales of a company during the year (the single dimension will be the row or column of 4 quarters of the year for which sales figures will be given). The following declarations create an array with 7 elements, with index numbers 0 to 6 (note that in the first declaration, the default lower bound is 0): Dim weekDays(6) As String or Dim weekDays(0 To 6) As String. The lower bound should be specified explicitly, using the To keyword. In the following declaration the array has 20 elements wherein the index numbers of Candidates range from 1 to 20: Dim Candidates(1 To 20) As Integer. In the following declaration the array has 51 elements wherein the index numbers of Candidates range from 100 to 150: Dim Candidates(100 To 150) As Integer. Formats for one dimensional array declaration, without and with specifying lower bound respectively: Dim ArrayName(Index) as DataType; Dim ArrayName(First_Index To Last_Index) as DataType.

 

 

Example 1: One-Dimensional Array - refer Image 1.

 

 

Sub demoArray1()


Dim myArray(3) As String

 

myArray(0) = "Mon"
myArray(1) = "Tue"
myArray(2) = "Wed"
myArray(3) = "Thur"


MsgBox myArray(0) & ", " & myArray(1) & ", " & myArray(2) & ", " & myArray(3)


End Sub

 

 

 

Example 2: One-Dimensional Array - refer Image 2.

 

 

Sub demoArray2()


Dim myArray(-3 To 2) As String


myArray(-3) = "Mon"
myArray(-2) = "Tue"
myArray(-1) = "Wed"
myArray(0) = "Thurs"
myArray(1) = "Fri"
myArray(2) = "Sat"


MsgBox myArray(-3) & ", " & myArray(-2) & ", " & myArray(-1) & ", " & myArray(0) & ", " & myArray(1) & ", " & myArray(2)


End Sub

 

 

 

Example 3: Manage Arrays (One-Dimensional) with VBA Loops - refer Image 3.

 

 

Sub demoArray3()
'manage Arrays with vba Loops


Dim i As Integer
Dim strFirstName(2 To 5) As String, sngHeight(2 To 5) As Single


For i = 2 To 5

strFirstName(i) = InputBox("Enter First Name")
sngHeight(i) = InputBox("Enter Height in cms")


Sheet4.Cells(i, 1) = strFirstName(i)
Sheet4.Cells(i, 2) = sngHeight(i) & " cms"

Next i


End Sub

 

 

 

Multi-Dimensional Arrays:

 

A two-dimensional array has 2 dimensions, comprising rows and columns and uses two indexes. One index represents the rows and the other index represents the columns. These are used when an element is required to be specified using two attributes, example, Quarterly Sales of a company over the past 5 years (one dimension will be the 4 quarters of the year and the second dimension will be the 5 years - sales figures will be mentioned for each quarter across 5 years). A two-dimensional array appears as a table format, with multiple rows & columns. It is declared as Dim ArrayName(Index1,Index2) as DataType; Dim ArrayName(First_Index1 to Last_Index1,First_Index2 to Last_Index2) as DataType. Examples of declaring two-dimensional arrays: Dim students(7,9) as Long; Dim students (7,1 to 9) as Long. The respective size of these arrays is 80 (dimension sizes 8 and 10) and 72 (dimension sizes 8 and 9). Note: The lower bound can be specified explicitly in either one or both the dimensions.

 

Only sometimes do you need to work with three-dimensional arrays. These have 3 dimensions and use three indexes. Though the maximum limit of dimensions an array can have is 32, very rarely do they cross three-dimensions. Format for declaring a three-dimensional array: Dim ArrayName(Index1,Index2,Index3) as DataType; Dim ArrayName(First_Index1 to Last_Index1,First_Index2 to Last_Index2,First_Index3 to Last_Index3) as DataType. Example of declaring a three-dimensional array: Dim students (7,1 to 5,1 to 15) as Long. The size of this array (ie. total number of elements) is 600, with dimension sizes 8, 5 and 15.

 

 

 

Differentiating Use of One-Dimensional and Multi-Dimensional Arrays

 

Declare a one-dimensional array with 4 elements, one for each quarter of the year - refer Example 4:

Quarterly Sales of a company during the year:   Dim sales(1 To 4) As Long

 

 

Example 4: Using One-Dimensional Array - refer Image 4.

 

 

Sub demoArray4()
'using a one-dimensional array: Quarterly Sales of a company during the year.


Dim i As Integer
Dim lSales(1 To 4) As Long


lSales(1) = 100
lSales(2) = 120
lSales(3) = 145
lSales(4) = 95


For i = 1 To 4

Sheet6.Cells(i, 2) = lSales(i)

Next i


End Sub

 

 

 

Declare a two-dimensional array with 4 rows (for the quarters) and 5 columns (for the years) - refer Example 5:

Quarterly Sales of a company over the past 5 years:   Dim sales(1 To 4, 1 To 5) As Long

 

 

Example 5: Using Two-Dimensional Array - refer Image 5.

 

 

Sub demoArray5()
'using a two-dimensional array: Quarterly Sales of a company over the past 5 years.


Dim i As Integer, n As Integer


Dim lSales(1 To 4, 1 To 5) As Long


lSales(1, 1) = 500
lSales(2, 1) = 520
lSales(3, 1) = 545
lSales(4, 1) = 595


lSales(1, 2) = 410
lSales(2, 2) = 440
lSales(3, 2) = 425
lSales(4, 2) = 485


lSales(1, 3) = 320
lSales(2, 3) = 330
lSales(3, 3) = 335
lSales(4, 3) = 300


lSales(1, 4) = 250
lSales(2, 4) = 280
lSales(3, 4) = 275
lSales(4, 4) = 205


lSales(1, 5) = 150
lSales(2, 5) = 180
lSales(3, 5) = 175
lSales(4, 5) = 105

 


For i = 1 To 4

For n = 1 To 5

Sheet6.Cells(i + 1, n + 1) = lSales(i, n)

Next n

Next i


End Sub

 

 

 

Declare a three-dimensional array with 4 layers (for the blocks), 4 rows (for the quarters), and 5 columns (for the years):

Quarterly Sales of a company each block of 5 years in the previous 2 decades:   Dim sales(1 To 4, 1 To 4, 1 to 5) As Long

 

 

 

Fixed-size and Dynamic Arrays; ReDim Statement to Resize Dynamic Array.

 

Fixed-size and Dynamic Arrays: Two type of arrays can be created in VBA, Fixed-size and Dynamic Arrays. An array which has a fixed number of elements is a fixed-size array and is used when you know in the beginning of writing the code, the precise number of elements you need in the array. Most times you will need to create dynamic arrays because you will not know the exact size of the array required in the code in the beginning and flexibilty to change the number of array elements will be required to run the code. Besides being a convenient VBA tool, dynamic arrays help in conserving memory to only what is actually required. Arrays can be of any data type, which will mean that each element of the array will be of that same data type (viz. String, Long, ...).

 

ReDim Statement: Declare a dynamic variable with empty parentheses ie. leaving the index dimensions blank. You can thereafter size or resize the dynamic array that has already been declared, by using the ReDim statement. To resize an array, it is necessary to provide the upper bound, while the lower bound is optional. If you do not mention the lower bound, it is determined by the Option Base setting for the module, which by default is 0. You can specify Option Base 1 in the Declarations section of the module and then index will start from 1. This will mean that respective index values of an array with 3 elements will be 1, 2 and 3. Not entering Option Base 1 will mean index values of 0, 1 and 2.

 

For example, Declare the myArray array as a dynamic array:  Dim myArray() As String. To set the array's size and resize the array to 3 elements (specify Option Base 1), use the Redim statement:  ReDim myArray(3) As String. Use Dynamic Arrays instead of a fixed-size array, if you want to adjust to the changing number of records in your database at run-time. See examples 6 to 8 below, for working with Dynamic Arrays.

 

 

Example 6: Declare a Dynamic Array. Refer Image 6.

 

 

Option Base 1
-----------------------------------------------

Sub demoArray6()
'declare dynamic array


Dim myArray() As String
ReDim myArray(3) As String


myArray(1) = "Mon"
myArray(2) = "Tue"
myArray(3) = "Wed"


MsgBox myArray(1) & ", " & myArray(2) & ", " & myArray(3)


End Sub

 

 

 

Example 7: Declare Dynamic Array: Redim statement without Preserve keyword. Refer Image 7.

 

 

Option Base 1
----------------------------------------------

Sub demoArray7()
'declare dynamic array: Redim statement without Preserve keyword


Dim myArray() As String
ReDim myArray(3) As String


myArray(1) = "Mon"
myArray(2) = "Tue"
myArray(3) = "Wed"


ReDim myArray(4) As String


myArray(4) = "Thurs"


MsgBox myArray(1) & ", " & myArray(2) & ", " & myArray(3) & ", " & myArray(4)


End Sub

 

 

 

Dynamic Arrays - use the 'Preserve' Keyword with the ReDim statement:

 

When an array is resized using the ReDim statement, its values might get lost. To ensure that the array values are not lost, use the 'Preserve' Keyword with the ReDim statement, which will enable to retain the existing data in the array. For example, first the ReDim statement used to size the myArray array was:  "ReDim myArray(3) As String"  and then 3 elements were populated. To resize the array to allow 4 variables without losing the existing data, you should use the statement  "ReDim Preserve myArray(4) As String". Refer Example 8.

 

 

Example 8: Declare Dynamic Array: Redim statement WITH Preserve keyword. Refer Image 8.

 

 

Option Base 1
---------------------------------------------

Sub demoArray8()
'declare dynamic array: Redim statement WITH Preserve keyword


Dim myArray() As String
ReDim myArray(3) As String


myArray(1) = "Mon"
myArray(2) = "Tue"
myArray(3) = "Wed"


ReDim Preserve myArray(4) As String


myArray(4) = "Thurs"


MsgBox myArray(1) & ", " & myArray(2) & ", " & myArray(3) & ", " & myArray(4)


End Sub

 

 

 

The Redim statement: (i) cannot change the array's DataType; (ii) it cannot change the number of dimensions in an array; and (iii) if you use the "Preserve" keyword, it can resize only the last dimension of the array, so that in a multidimensional array the same bounds should be specified for all other dimensions. Refer Example 9.

 

 

Example 9: Use Redim statement with a two-dimensional array. Refer Images 9a (first redim statement sizes the array) & 9b (after resizing dimension 2 with the second redim statement) & 9c (after reducing array size with the third redim statement).

 

 

 

 

Sub demoArray9()
'Redim a two-dimensional array


Dim iYr As Integer, iQtr As Integer, iYrExtend As Integer, iUbDimQtr As Integer, iUbDimYr As Integer, iUbDimYrRedim As Integer, strRange As String

 

'first dimension specifies 4 quarters of a year and second dimension specifies 2 years, for which sales figures will be entered
Dim myArray() As Integer
ReDim myArray(1 To 4, 1 To 2)


'determine upper bounds of the 2 dimensions:
iUbDimQtr = UBound(myArray, 1)
iUbDimYr = UBound(myArray, 2)


For iYr = 1 To iUbDimYr

For iQtr = 1 To iUbDimQtr

myArray(iQtr, iYr) = InputBox("Enter sales in Quarter " & iQtr & " Year " & iYr)

Sheet7.Cells(iQtr + 1, iYr + 1) = myArray(iQtr, iYr)

Next iQtr

Next iYr

 

'you can enter any condition here, subject to which Redim statement will be used again
If MsgBox("Continue to Year 3?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then

'Redim statement will accomodate sales figures for 3 years, from previous 2 years, for the 4 quarters
ReDim myArray(1 To 4, 1 To iUbDimYr + 1)

'determine upper bound of second dimension, after resizing with the second redim statement:
iUbDimYrRedim = UBound(myArray, 2)

'for each of the 4 quarters, enter sales figures for the additional year(s):
For iYrExtend = 1 To iUbDimQtr

myArray(iYrExtend, iUbDimYrRedim) = InputBox("Enter sales in Quarter " & iYrExtend & " Year " & iUbDimYrRedim)

Sheet7.Cells(1, 4) = "Year 3"
Sheet7.Cells(iYrExtend + 1, iUbDimYrRedim + 1) = myArray(iYrExtend, iUbDimYrRedim)

Next iYrExtend

End If

 

'you can enter any condition here, subject to which Redim statement will be used again
If MsgBox("Continue to reduce array size?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then

'delete previously entered data:
With Sheets("Sheet7")

strRange = .Name & "!" & .Cells(2, "B").Address & ":" & .Cells(iUbDimQtr + 1, iUbDimYr + 2).Address

End With

Sheet7.Range(strRange).ClearContents

'Redim statement will accomodate sales figures for 2 years, for 2 quarters.
ReDim myArray(1 To 2, 1 To 2)
For iYr = 1 To 2

For iQtr = 1 To 2

myArray(iQtr, iYr) = InputBox("Enter sales in Quarter " & iQtr & " Year " & iYr)

Sheet7.Cells(iQtr + 1, iYr + 1) = myArray(iQtr, iYr)

Next iQtr

Next iYr

End If


End Sub 

 

 

 

 

Excel VBA Functions: SPLIT a String and return an Array of Substrings; JOIN an Array of Substrings to form a String.

 

The vba Split Function splits a string expression into specified number of substrings, as delimited by a character(s), which are returned as a zero-based one-dimensional array. The vba Join Function joins the substrings contained in an array, and returns a string with the substrings separated by a delimited character(s).

 

 

Example 10 - Using the vba Split function to count & return words within a string - refer Image 10.

 

 

Sub SplitFunc_Array()
'using the vba Split function to count & return words within a string - refer Image 10.

 

Dim arr As Variant, varExp As Variant, varDelim As Variant, varWords As Variant

Dim i As Integer

 

'specify string which will be split into substrings:

varExp = "    She sells    sea   shells near the    sea shore.  "

'specify space as the delimiter for substrings:

varDelim = " "

 

'Use the worksheet TRIM function to removes all spaces from text except for single spaces between words.

varExp = Application.Trim(varExp)

 

'use the Split function to return a zero-based one-dimensional Array of substrings:

arr = Split(varExp, varDelim)

 

'returns the number of elements/words (8) in the string:

MsgBox UBound(arr) + 1

 

'return each word of the string on a separate line:

For i = 0 To UBound(arr)

If i = 0 Then

'not to give a line break before the first word:

varWords = arr(i)

Else

varWords = varWords & vbLf & arr(i)

End If

Next i

 

'returns each word in a separate line - Image 10:

MsgBox varWords

 

End Sub

 

 

 

 

Example 11 - Using CONCATENATE or JOIN, to join an array of cell values and return a string; shows how to declare a dynamic array, resize the dynamic array by using the ReDim statement, and using the 'Preserve' Keyword with the ReDim statement.

 

To download Excel file with live code, click here.

 

 

Sub Join_Concatenate_Array()
'Join an array of cell values within a defined worksheet range - using JOIN & CONCATENATE for the same affect. Refer Image 11 for rng ie. ActiveSheet.Range("A2:E4").

 

Dim rng As Range, iRow As Integer, iCol As Integer, i As Integer

 

'refer Image 11 for rng:

Set rng = ActiveSheet.Range("A2:E4")

 

'---------------------

'CONCATENATE

 

Dim varConctnt As Variant

 

For iRow = 1 To rng.Rows.Count

For iCol = 1 To rng.Columns.Count

If Not rng(iRow, iCol).Value = vbNullString Then

'Concatenate with &:

varConctnt = varConctnt & "," & rng(iRow, iCol).Value

End If

Next iCol

'if array is empty:

If varConctnt = vbNullString Then MsgBox "Empty Array": GoTo skip1

'returns one string at a time in this order - "James Mitch,Dallas,44,Male,Maried" ; "Tom Halter,Tampa,28,Male,Unmarried" ; "Tracy White,Boston,35,Female,Married"

MsgBox Mid(varConctnt, 2)

varConctnt = ""

skip1:

Next iRow

 

'---------------------

'JOIN

 

'declare a dynamic array:

Dim varArr() As Variant

 

iColumn = rng.Columns.Count

i = 0

'resize the dynamic array (one-dimensional) that has already been declared, by using the ReDim statement:

ReDim varArr(iColumn - 1) As Variant

 

For iRow = 1 To rng.Rows.Count

For iColumn = 1 To rng.Columns.Count

If Not rng(iRow, iColumn).Value = vbNullString Then

'for each vbNullString, decrease the array index value:

varArr(iColumn - 1 - i) = rng(iRow, iColumn).Value

Else

'count number of vbNullString:

i = i + 1

'if array is empty:

If i = rng.Columns.Count Then MsgBox "Empty Array": GoTo skip2

End If

Next iColumn

'decrease array size by number of vbNullString - ensure array values are not lost by using the 'Preserve' Keyword with the ReDim statement:

ReDim Preserve varArr(rng.Columns.Count - 1 - i) As Variant

'using the Join function with comma as delimiter - returns one string at a time in this order - "James Mitch,Dallas,44,Male,Maried" ; "Tom Halter,Tampa,28,Male,Unmarried" ; "Tracy White,Boston,35,Female,Married":

MsgBox Join(varArr, ",")

skip2:

'clear & resize array:

ReDim varArr(rng.Columns.Count - 1) As Variant

i = 0

Next iRow

 

End Sub

 

 

 

 

Create a 200-Year Calendar in VBA, using Arrays with Loops - refer Image 12. See below codes. Click to download the Calendar (excel file).

 

 

 

 

Enter code in the code module for "ThisWorkbook" in VBE, Project Explorer - as a workbook open event:

 

Private Sub Workbook_Open()
'generate calendar years ie. validation list, when workbook is opened


Dim rngList As Range, rngCalendarYearCell As Range, strStoredYear As String, a As Integer, intRow As Integer, counter As Integer, ws As Worksheet


'check validity of worksheet name:

counter = 0

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Calendar" Then

counter = 1

Exit For

End If

Next


If Not counter = 1 Then

MsgBox "ERROR! Worksheet named 'Calendar' not found."

Exit Sub

End If


Application.EnableEvents = False

 

Set ws = Worksheets("Calendar")


'address of cell/range which contains Calendar Year:

Set rngCalendarYearCell = ws.Range("H7")


'save previous calendar year (year selected before closing the workbook previously) in variable:

strStoredYear = rngCalendarYearCell.Value


ws.Range("A:Z").Clear

ws.Columns("A:Z").EntireColumn.Hidden = False

 

'create validation list dynamically:

For a = 1900 To 2100

ws.Cells(a - 1899, 26) = a

Next a


'find last used row in column Z:

intRow = ws.Cells(Rows.Count, "Z").End(xlUp).Row

'create named list:

ws.Range("Z1:Z" & intRow).Name = "rngList"


With rngCalendarYearCell

With .Validation

.Delete

.Add Type:=xlValidateList, Formula1:="=rngList"

End With

End With


Application.EnableEvents = True


'restore previous calendar year:

rngCalendarYearCell.Value = strStoredYear


'hide column which is source of the validation list:

ws.Columns("Z:Z").EntireColumn.Hidden = True


'formatting:

With ws.Range("H6:H7")

.Font.Name = "Arial"

.Font.Size = 9

.RowHeight = 12.75

.HorizontalAlignment = xlCenter

.ColumnWidth = 15

.Font.Bold = True

End With


With ws.Range("H1:H2")

.Font.Name = "Arial"

.Font.Size = 10

.HorizontalAlignment = xlCenter

.Font.Bold = True

.Interior.Color = RGB(0, 32, 96)

.Font.Color = RGB(255, 255, 255)

End With


With ws.Range("H4")

.Font.Name = "Arial"

.Font.Size = 10

.HorizontalAlignment = xlLeft

.Font.Color = RGB(255, 0, 0)

End With


ws.Range("H1") = "200-YEAR"

ws.Range("H2") = "CALENDAR"

ws.Range("H4") = "This Calendar works with regional settings set to English (United States) on your desktop."


ws.Range("H6") = "SELECT YEAR:"

ws.Range("H6").Interior.Color = RGB(0, 176, 240)

ws.Range("H7").Interior.Color = RGB(255, 255, 0)

ws.Range("H7").Font.Color = RGB(0, 0, 255)

ws.Range("H7").Borders.LineStyle = XlLineStyle.xlContinuous


End Sub

 

 

 

Enter code in the code module of the appropriate Sheet ie. in the worksheet named "Sheet 1" - as a worksheet change event:

 

Private Sub Worksheet_Change(ByVal Target As Range)
'200-YEAR CALENDAR, using vba Arrays with vba Loops - the calendar will generate on selection of the relevant year:


Dim iMth As Integer, i As Integer, b As Integer, iDt As Integer, m As Integer, x As Integer, counter As Integer, w As Integer, y As Integer, iDays As Integer, iRow As Integer, iFirstDay As Integer, iMthDays As Integer

Dim dtDay As Date, dtLeapYear As Date, rngCalendarYearCell As Range

Dim ws As Worksheet

Dim strMonthName(1 To 12) As String, strWeekDay(1 To 7) As String, strWkDay As String


On Error GoTo ResetApplication

'will enable events (worksheet change) on error


'check validity of worksheet name:

If Not ActiveSheet.Name = "Calendar" Then

MsgBox "Please name worksheet as 'Calendar' to continue"

Exit Sub

End If


Set ws = Worksheets("Calendar")


'address of cell/range which contains Calendar Year:

Set rngCalendarYearCell = ws.Range("H7")


'At least one cell of Target is within the range - rngCalendarYearCell:

If Not Application.Intersect(Target, rngCalendarYearCell) Is Nothing Then


'turn off some Excel functionality so the code runs faster

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.DisplayStatusBar = False

Application.Calculation = xlCalculationManual


If rngCalendarYearCell = "" Then

MsgBox "Select Year to Generate Calendar"

GoTo ResetApplication

Exit Sub

End If


'clear first 7 columns and any previous calendar:

ws.Range("A:G").Clear


'set names of 12 months for the array strMonthName:

strMonthName(1) = "January"

strMonthName(2) = "February"

strMonthName(3) = "March"

strMonthName(4) = "April"

strMonthName(5) = "May"

strMonthName(6) = "June"

strMonthName(7) = "July"

strMonthName(8) = "August"

strMonthName(9) = "September"

strMonthName(10) = "October"

strMonthName(11) = "November"

strMonthName(12) = "December"


'set names of 7 week days for the array strWeekDay:

strWeekDay(1) = "Monday"

strWeekDay(2) = "Tuesday"

strWeekDay(3) = "Wednesday"

strWeekDay(4) = "Thursday"

strWeekDay(5) = "Friday"

strWeekDay(6) = "Saturday"

strWeekDay(7) = "Sunday"

'for each of the 12 months in a year

For iMth = 1 To 12


counter = 1


'determine day 1 for each month:

If iMth = 1 Then

dtDay = "1/1/" & rngCalendarYearCell

strWkDay = Application.Text(dtDay, "dddd")

If strWkDay = "Monday" Then

iFirstDay = 1

ElseIf strWkDay = "Tuesday" Then

iFirstDay = 2

ElseIf strWkDay = "Wednesday" Then

iFirstDay = 3

ElseIf strWkDay = "Thursday" Then

iFirstDay = 4

ElseIf strWkDay = "Friday" Then

iFirstDay = 5

ElseIf strWkDay = "Saturday" Then

iFirstDay = 6

ElseIf strWkDay = "Sunday" Then

iFirstDay = 7

End If

Else

iFirstDay = iFirstDay

End If


'determine number of days in each month and the leap year:

dtLeapYear = "2/1/" & rngCalendarYearCell


m = month(dtLeapYear)

y = Year(dtLeapYear)


iDays = DateSerial(y, m + 1, 1) - DateSerial(y, m, 1)


If iMth = 1 Or iMth = 3 Or iMth = 5 Or iMth = 7 Or iMth = 8 Or iMth = 10 Or iMth = 12 Then

iMthDays = 31

ElseIf iMth = 2 Then

If iDays = 28 Then

iMthDays = 28

ElseIf iDays = 29 Then

iMthDays = 29

End If

Else

iMthDays = 30

End If


'determine last used row:

If iMth = 1 Then

iRow = 0

Else

iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

End If


iDt = 1


'maximum of 6 rows to accomodate all days of a month:

For i = 1 To 6

'7 columns for each week day of Monday to Sunday:

For b = 1 To 7

'enter name of the month:

ws.Cells(iRow + 1, 1) = strMonthName(iMth)

ws.Cells(iRow + 1, 1).Font.Color = RGB(255, 0, 0)

ws.Cells(iRow + 1, 1).Font.Bold = True

ws.Range("A" & iRow + 1 & ":G" & iRow + 1).Interior.Color = RGB(191, 191, 191)

ws.Range("A" & iRow + 1 & ":G" & iRow + 1).Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous


'enter week day (Monday, Tuesday, ...):

ws.Cells(iRow + 2, b) = strWeekDay(b)

ws.Range("A" & iRow + 2 & ":G" & iRow + 2).Font.Bold = True

ws.Range("A" & iRow + 2 & ":G" & iRow + 2).Interior.Color = RGB(216, 216, 216)


'enter each date in a month:

If iDt <= iMthDays Then

'dates placement for the first row (for each month):

If iFirstDay > 1 And counter = 1 Then

For x = 1 To 8 - iFirstDay

ws.Cells(iRow + 2 + i, iFirstDay + x - 1) = x

Next x

iDt = 9 - iFirstDay

'after placement of dates in the first-row for a month the counter value changes to 2, and then reverts to 1 for the next month cycle:

counter = 2

w = 1

End If


'dates placement after the first row (for each month):

ws.Cells(iRow + 2 + i + w, b) = iDt

iDt = iDt + 1

End If

Next b

Next i

w = 0


'determine placement of day 1 for each month after the first month:

iFirstDay = iFirstDay + iMthDays Mod 7


If iFirstDay > 7 Then

iFirstDay = iFirstDay Mod 7

Else

iFirstDay = iFirstDay

End If


Next iMth

 

'formatting:

iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

ws.Range("A" & iRow & ":G" & iRow).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous

ws.Range("G1:G" & iRow).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous


With ws.Range("A1:G" & iRow)

.Font.Name = "Arial"

.Font.Size = 9

.RowHeight = 12.75

.HorizontalAlignment = xlCenter

.ColumnWidth = 9

End With

 

End If


Application.DisplayAlerts = True

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.DisplayStatusBar = True

Application.Calculation = xlCalculationAutomatic


ResetApplication:

    Err.Clear

    On Error GoTo 0

    Application.EnableEvents = True

    
End Sub

 

 

 

ParamArray (Parameter Array)

 

It is not possible to call a procedure with more arguments than the procedure declaration specifies. VBA allows use of optional parameters but you have to know the number of elements in the array ahead of time, when you define the procedure. The ParamArray keyword lets you pass in any number of values. The function receives them as an array. The ParamArray argument makes it possible for a procedure (a function or a subroutine) to accept an arbitrary number of arguments, each of a possibly different type (by using a Variant). ParamArrays have been illustrated in detail in the section: Passing Arguments to Procedures, Parameter Arrays (ParamArray).