This example demonstrates a simply way of looping through a static array variable to retrieve the values. It assumes we simply want to use the initial 5 items for our dropdown – this can be amended as required. The example also contains hard-coded array bounds (1 to 5) – when developing a workbook, these should not be hard-coded for the same reasons we mentioned above.

The code below declares a static array variable, looping through the array, getting our values from a the ‘Data’ worksheet, then adding each value to the items in dropdown Cmb.
_______________________________
Sub GetValues(Cmb)

Dim iIndex(1 To 5) As String ‘Declares the static array variable
Dim iCount As Integer
For iCount = 1 To 5
iIndex(iCount) = _
Format(ThisWorkbook.Worksheets(“Data”).Cells(iCount, 1), “Mmmm yyyy”)
With Cmb
.AddItem iIndex(iCount) ‘, iCount
End With
Next iCount

End Sub
_______________________________

To get these values into the Custom Command Bar, we’ll slightly amend our code from earlier. We’ll replace our hard-coded values with Call GetValues(Cmb) code – this will retrieve the values for each item from the code above.

_______________________________

Sub CustomToolbar()

Dim cbar As Object
Dim Cmb As Object
Dim SubMenu As Object
Dim NewCb As Object
Dim SubMenu1 As Object
Dim SubMenu2 As Object
Dim SubMenu3 As Object

On Error Resume Next

Set cbar = CommandBars.Add(Name:=”Sculpt”, Position:=msoBarTop, Temporary:=True)
cbar.Visible = True
cbar.Enabled = True

Dim NewMenu As Object
Set NewMenu = CommandBars(”Sculpt”)
With NewMenu
.Visible = True
.Enabled = True
.Controls.Add(Type:=msoControlPopup, before:=1).Caption = “Sculpt”
.Controls.Add(Type:=msoControlDropdown, before:=2).Caption = “Select period”
.Controls.Add(Type:=msoControlButton, before:=3).Caption = “Get data”
End With
‘Add Sub Menus to Sculpt

Set SubMenu = CommandBars(”Sculpt”).Controls(”Sculpt”)
With SubMenu
.TooltipText = “Select for further options”
.Controls.Add(Type:=msoControlPopup, before:=1).Caption = “Print”
.Controls.Add(Type:=msoControlButton, before:=2).Caption = “Get Budgets”
End With

Set Cmb = CommandBars(”Sculpt”).Controls(”Select period”)
With Cmb
.Width = 120
.Visible = True
.Enabled = True

‘Get the values for the dropdown from GetValues(Cmb)
Call GetValues(Cmb)
.ListIndex = 1 ‘Item to display in the dropdown list

‘.OnAction = “‘” & ThisWorkbook & “‘!SubName”
End With

Set NewCb = CommandBars(”Sculpt”).Controls(”Get Data”)
With NewCb
.Visible = True
.FaceId = 7433
End With

‘Now add sub-menu items
Set SubMenu1 = CommandBars(”Sculpt”).Controls(”Sculpt”).Controls(”Print”)
With SubMenu1
.Controls.Add(Type:=msoControlButton, before:=1).Caption = “All Records”
.Controls(”All Records”).FaceId = 109
.Controls.Add(Type:=msoControlButton, before:=2).Caption = “Active Records”
.Controls(”Active Records”).FaceId = 928
End With

Set SubMenu2 = CommandBars(”Sculpt”).Controls(”Get data”)
With SubMenu2
.OnAction = “‘” & ActiveWorkbook.Name & “‘!SubName”
End With

Set SubMenu3 = CommandBars(”Sculpt”).Controls(”Sculpt”).Controls(”Get Budgets”)
With SubMenu3
.OnAction = “‘” & ActiveWorkbook.Name & “‘!SubName”
End With

‘Begin groups
Application.CommandBars(”Sculpt”).Controls(”Sculpt”) _
.Controls(”Get budgets”).BeginGroup = True

Set NewMenu = CommandBars(”Sculpt”)
With NewMenu
.Protection = msoBarNoChangeVisible ‘Stops the user from deleting the command bar

End With

End Sub
_______________________________

First off, place all workbooks that need compiling into a distinct folder. In this example, I’ve placed them in:

C:\Documents and Settings\[username]\My Documents\Excel Application Development\MyWorkbooks\Workbooks\COMPILE\

The example gets all data from worksheet “Data” in the folder’s workbooks, compiling them as a list into this workbook. This code assumes the workbooks have exactly the same structure – therefore, values in column A are compiled to the new worksheet’s column A, column B to column B, etc…. We’ll use the Folder Dialog to find the location of the workbooks. Place this function in a blank module:
____________________________

Public Function GetFolder() As Variant

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

With fd
.Title = “Select folder…” ‘customise the dialog box title
.InitialFileName = “C:\Documents and Settings\[username]\My Documents\Excel Application Development\My Workbooks\Workbooks\COMPILE\” ‘initial folder name to ‘display
‘The user pressed the action button.
If .Show = -1 Then
‘Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
‘The example declares the folder as a variant that’s used in the sub above.
GetFolder = vrtSelectedItem
Next vrtSelectedItem
Else
End If
End With

Set fd = Nothing

End Function
____________________________

When running through the workbooks, we’ll also want to make sure the worksheet “Data” exists in each workbook. To do this, use this function:
____________________________

Public Function SheetExists(SheetName As String) As Boolean
‘Returns True if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet

If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If

NoSuchSheet:

End Function

____________________________

The next thing we’ll need is some code that loops through all files in the specifed folder, checks that they are Excel workbooks, additionally checks they contain the worksheet “Data”, then if these conditions are met, compiles the data into our worksheet. To do this, we’ll amend the code we used here when listing files in a specifed folder. Ensure you enable the Microsoft ScriptingRuntime reference for this to work.

____________________________

Sub ListFilesInFolder(SourceFolderName As String)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Integer
Dim x As Integer

On Error GoTo ErrHandler ‘If the SourceFolderName from GetFolder is empty

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
i = 2 ‘Start row to compile data in ThisWorkbook

For Each FileItem In SourceFolder.Files ‘Loops through files in GetFolder
If FileItem.Type = “Microsoft Excel Worksheet” Then ‘Ignores non-excel files
myFile = FileItem.Name
Workbooks.Open (myFile)

If SheetExists(“Data”) = True Then ‘Check if worksheet contains “Data” worksheet
‘Compile the data from here
x = 2 ‘Start row of each opened workbook
Do Until Workbooks(myFile).Worksheets(“Data”).Cells(x, 1).Value = “”
‘Change this code as required for your worksheet structure
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 1).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 1).Value
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 2).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 2).Value
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 3).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 3).Value
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 4).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 4).Value
x = x + 1
i = i + 1
Loop
Else
End If
Workbooks(myFile).Close False
End If
Next FileItem ‘Loops through next file

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ErrHandler:
‘If SourceFolderName from GetFolder is empty
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Exit Sub

End Sub
____________________________

The final bit of code calls ListFilesInFolder(SourceFolderName As String):
____________________________

Sub TestListFilesInFolder()

ListFilesInFolder GetFolder

End Sub
____________________________

To run this, just change the worksheet name and amend the required columns. Run the process from TestListFilesInFolder, selecting the folder from the Folder Dialog box.

____________________________

___________________________________

Sub OpenFile()

Dim OpenFileName As Variant

OpenFileName = Application.GetOpenFilename() ‘Opens the File Dialog
If OpenFileName = False Then Exit Sub ‘If no file selected
Workbooks.Open (OpenFileName)
Call WorksheetCheck(OpenFileName) ‘Check if worksheet exists
ActiveWorkbook.Close False

End Sub

___________________________________

The sub WorksheetCheck(OpenFileName) checks to see if the specified worksheet – “Data” – exists in the selected workbook. For this we need a new sub and a function – specify the name of the worksheet you’re checking for in the new sub. The function simply returns a True/ False to the sub, then displays a message box.

___________________________________

Sub WorksheetCheck(OpenFileName)

If SheetExists(“Data”) = True Then
MsgBox (“The worksheet exists”)
Else
MsgBox (“The worksheet doesn’t exist”)
End If

End Sub
___________________________________

Function SheetExists(SheetName As String) As Boolean
‘ True if worksheet exists in selected workbook
SheetExists = False
On Error GoTo NoSuchSheet

If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If

NoSuchSheet:

End Function

___________________________________

First off, we’ll want the main code to find the files. The code below works for the main folder picked – change the code as indicated if you wish to search within sub-folders.

To get this code to work, you need to make sure you have the Microsoft Scripting Runtime reference – select this from Tools > References > Microsoft Scripting Runtime.

___________________________________

Sub ListFilesInFolder(SourceFolderName As String) ‘For sub-folders, use
‘(SourceFolderName As String, IncludeSubfolders As Boolean)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File

On Error GoTo ErrHandler ‘If the SourceFolderName from GetFolder is empty

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)

For Each FileItem In SourceFolder.FileS
‘Get the file names – declare as myFile
myFile = FileItem.Name

‘**********************************************
‘Pass the filenames to another sub – you can then use the filenames for some ‘purpose, either opening, copying, merging. This example just shows the file ‘name in a message box.
‘**********************************************
Call NewTest(myFile)
Next FileItem ‘Loops through all files in SourceFolder.FileS

‘Add code below if using sub-folders

‘If IncludeSubfolders Then
‘For Each SubFolder In SourceFolder.SubFolders
‘ListFilesInFolder ‘SubFolder.Path, True
‘Next SubFolder
‘End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ErrHandler:
‘If SourceFolderName from GetFolder is empty
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Exit Sub

End Sub
___________________________________

Rather than hardcode the folder name, we can ask users to select it using the File dialog box. Use this code to open a customised file dialog box – in this example, we’ve set the default folder to C:\ and the title to “Select folder…”.
___________________________________

Public Function GetFolder() As Variant

Dim Fd As FileDialog
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

With Fd

.Title = “Select folder…” ‘customise the dialog box title
.InitialFileName = “C:\” ‘initial folder name to display
‘The user pressed the action button.
If .Show = -1 Then

For Each vrtSelectedItem In .SelectedItems
GetFolder = vrtSelectedItem
Next vrtSelectedItem
Else
End If
End With

Set Fd = Nothing

End Function
___________________________________

The next step is to create a small sub to call Sub ListFilesInFolder. All you need here is this:

___________________________________

Sub TestListFilesInFolder()

ListFilesInFolder GetFolder

‘Use: ListFilesInFolder GetFolder, True to include sub-folders

End Sub
___________________________________

The final step is to get our filenames into another sub, where we’ll do something with the filename. Here you can do exactly what you need, whether opening the file, renaming, listing the files in a workbook, getting the file properties.

This code simply gets the filename and displays it in a message box:
___________________________________

Sub NewTest(myFile)

MsgBox (myFile)

End Sub

___________________________________

Now run Sub TestListFilesInFolder(). All files in the specified folder will be displayed in a message box.

However, you may want to think about whether an Add-In is the best way of performing the task. If a workbook that utilises the Add-In is forwarded to a third-party, they will not be able to utilise the Add-In. While cell values based on the Add-In will not be altered, any attempt to recalculate the cell where the custom function is located will result in an error. To correct this, you would have to forward the workbook and the Add-In!

If you’re the only person likely to use the workbook, this obviously doesn’t present much of a problem. Equally, if you’re confident the Add-In is available to all other users of the workbook, there isn’t an issue. Therefore, only go ahead if one of these conditions have been met.

To create your Function Library Add-In, first create a new blank workbook, then insert a blank module. Paste the code from your custom function into the module – then run the Sub to create the description and category. To create a user-friendy title and description accesible from the Function Library dialog box, enter the details in the File Properties Title (Add-In title) and Comments (Add-In description) boxes. Then save the workbook as a .xla file in your Add-Ins folder – this is probably somewhere like:

\Documents and Settings\UserName\Application Data\Microsoft\AddIns

Then close the workbook.

Restart Excel. Select Tools > Add-Ins. Your new custom function will be available to install:

An easy way of doing this is creating a function, combining OFFSET and COUNTA. Using the OFFSET funtion the required arguments are:

Cell reference: the base point for OFFSET. Let’s define this as Rng!$A$1.

Rows: we want the upper-left row to be the same as the base point cell – therefore, enter 0.

Columns: we want the upper-left column to be the same as the base point cell – therefore, enter 0.

Height: in a dynamic range, the height of the range is the variable. We can get the height from the COUNTA function, returning a value for non-blank cells. In this example, the height will equal COUNTA(Rng!$A:$A).

Width: this is the width, in columns, that the reference will refer to. In this example, we’ll set this to 1.

We end up with this function:

=OFFSET(Rng!$A$1,0,0,COUNTA(Rng!$A:$A),1)

The named range can be defined manually through Insert > Name > Define > Refers To, where Refers To is our OFFSET function:

Alternatively you can define the named range through vba – you should define the named range when opening the workbook. To define the name using vba, use this code:

______________________________________

ThisWorkbook.Names.Add Name:=”NewDynamicRange”, RefersTo:= _
“=OFFSET(Rng!$A$1,0,0,COUNTA(Rng!$A:$A),1)”, Visible:=True
______________________________________

If you’re using the dynamic named range within a VLOOKUP function, change the width in the OFFSET function to the number of columns in the range – for a two column range, the function would read:

=OFFSET(Rng!$A$1,0,0,COUNTA(Rng!$A:$A),2)

We can create a custom IF(ISERROR) function in two easy steps:

1. Implement the custom function:
___________________________________
Public Function IFISERROR(ByRef Evaluate As Variant, _
ByRef Default As Variant) As Variant
If IsError(Evaluate) Then
IFISERROR = Default ‘if an error, returns default
Else
IFISERROR = Evaluate ‘no error, evaluates function
End If

End Function
___________________________________

The function is now available to use – this is accessible from the User Defined category in Insert Function. However, this offers no guide how the function works. You can add this information be registering the UDF in step 2.

2. Register the custom UDF:
___________________________________
Sub CreateCustomFunction()

Dim strDescription As String
strDescription = “A custom IF(ISERROR) function: ” & _
vbLf & “=IF(ISERROR(function),default value,function)”
‘this text will appear in the function dialog box
Application.MacroOptions Macro:=”IFISERROR”, _
Description:=strDescription, _
Category:=9 ’9=Information category of UDF category names

End Sub
___________________________________

Run the CreateCustomFunction (you can run this from the Workbook_Open event) and your new custom function will appear in the function dialog box:

First you’ll need to create your icon. You can do this using Paint. Make sure you save your icon as a 16 x 16 pixel 16-colour bmp – when designing it, zoom at 800% for greater clarity. Once created, save to the same path as your workbook.

You’ll also need to create a mask for the custom icon – do this by selecting Black & White from the Attributes in the Image options. The mask should be called something like IconMask.bmp.

Now you’re ready to run your code. This example is based on the previous custom command bar – the difference is that an additional control button is added to show the new icon. The code gets the icon and the icon mask from the same file path as your workbook – if your icons aren’t stored here, just change the code accordingly.

__________________________

Public Sub AddCustomIcon()

Dim cbar As Object
Dim Cmb As Object
Dim SubMenu As Object
Dim NewCb As Object
Dim SubMenu1 As Object
Dim SubMenu2 As Object
Dim SubMenu3 As Object
Dim SubMenu4 As Object
Dim strPath As String
On Error Resume NextSet cbar = CommandBars.Add(Name:=”Sculpt”, Position:=msoBarTop,

Temporary:=True)
cbar.Visible = True
cbar.Enabled = True

Dim NewMenu As Object
Set NewMenu = CommandBars(“Sculpt”)
With NewMenu
.Visible = True
.Enabled = True
.Controls.Add(Type:=msoControlButton, before:=1).Caption = “SculptIcon”
.Controls.Add(Type:=msoControlPopup, before:=2).Caption = “Sculpt”
.Controls.Add(Type:=msoControlDropdown, before:=3).Caption = _ “Select period”
.Controls.Add(Type:=msoControlButton, before:=4).Caption = “Get data”
End With

‘Add the custom icon
strPath = ThisWorkbook.Path ‘filepath of your workbook
If Right(strPath, 1) <> “\” Then strPath = strPath & “\”
Set SubMenu = CommandBars(“Sculpt”).Controls(“SculptIcon”)
With SubMenu
.Picture = LoadPicture(strPath & “Sculpt.bmp”)
.Mask = LoadPicture(strPath & “SculptMask.bmp”)
End With

‘Add the custom submenus
Set SubMenu1 = CommandBars(“Sculpt”).Controls(“Sculpt”)
With SubMenu1
.Controls.Add(Type:=msoControlPopup, before:=1).Caption = “Print”
.Controls.Add(Type:=msoControlButton, before:=2).Caption = “Get Budgets”
End With

‘Add the dropdown list items
Set Cmb = CommandBars(“Sculpt”).Controls(“Select period”)
With Cmb
.Width = 120
.Caption = “Select Month”
.Visible = True
.Enabled = True
.AddItem “November 2006″, 1
.AddItem “December 2006″, 2
.AddItem “January 2007″, 3
.AddItem “February 2007″, 4
.AddItem “March 2007″, 5
.ListIndex = 1
‘.OnAction = “‘” & ActiveWorkbook.Name & “‘!ShowValue”
End With

Set NewCb = CommandBars(“Sculpt”).Controls(“Get Data”)
With NewCb
.Caption = “Get data”
.Visible = True
.FaceId = 7433
End With

‘Now add sub-menu items
Set SubMenu2 = CommandBars(“Sculpt”).Controls(“Sculpt”).Controls(“Print”)
With SubMenu2
.Controls.Add(Type:=msoControlButton, before:=1).Caption = _ “All Records”
.Controls(“All Records”).FaceId = 109
.Controls.Add(Type:=msoControlButton, before:=2).Caption = _ “Active Records”
.Controls(“Active Records”).FaceId = 928
End With

Set SubMenu3 = CommandBars(“Sculpt”).Controls(“Get data”)
With SubMenu3
.OnAction = “‘” & ActiveWorkbook.Name & “‘!SubName”
End With

Set SubMenu4 = CommandBars(“Sculpt”).Controls(“Sculpt”).Controls(“Get Budgets”)
With SubMenu4
.OnAction = “‘” & ActiveWorkbook.Name & “‘!SubName”
End With

‘Begin groups
Application.CommandBars(“Sculpt”).Controls(“Sculpt”) _
.Controls(“Get budgets”).BeginGroup = True

Set NewMenu = CommandBars(“Sculpt”)
With NewMenu
.Protection = msoBarNoChangeVisible
End With

End Sub
__________________________

Your new custom command bar will look like this:

Use this array formula – you can use named ranges, as in the example. However, the named range must refer to the same rows: i.e. you could use named ranges referring to A2:A1000 and B2:B1000, but A2:A500 and B2:B2000 would not work.

{=SUM((CData=$A$9)*(BData=$B$9))}

This counts the number of records where the named range CData = $A$9 AND BData = $B$9.

You must press CTRL + SHIFT + ENTER for the array formula to function.

The above example functions as an AND statement. You can modify this to an OR by replacing * with +, counting the number of records where CData = $A$9 OR BData = $B$9:

{=SUM((CData=$A$9)+(BData=$B$9))}

This code removes all controls except Insert Comments – this is done by looping through all controls available in the Cells command bar, deleting all except Insert Comments. We then add two additional controls: one named Sculpt and a further dropdown similar to that in our customised command bar. The code is run from the Worksheet_BeforeRightClick event.

_____________________

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)

Dim icbc As Object
Dim myBar As Object
Dim Cmb As Object
On Error Resume Next

CommandBars(“Cell”).Reset
CommandBars(“Cell”).Enabled = True

For Each icbc In Application.CommandBars(“Cell”).Controls
If icbc.ID = 21 Or icbc.ID = 19 Or icbc.ID = 22 Or icbc.ID = 755 Or icbc.ID = 3181 Or icbc.ID = 292 _
Or icbc.ID = 3125 Or icbc.ID = 855 Or icbc.ID = 1966 Or icbc.ID = 1576 Or icbc.ID = 30094 _
Or icbc.ID = 7193 Or icbc.ID = 5685 Or icbc.ID = 577 Or icbc.ID = 7685 Then icbc.Delete
Next icbc

With Application.CommandBars(“Cell”)
.Controls.Add(Type:=msoControlButton, before:=2).Caption = “Sculpt”
.Controls.Add(Type:=msoControlDropdown, before:=3).Caption = _

“Find month”
End With

Set Cmb = CommandBars(“Cell”).Controls(“Find month”)
With Cmb
.Width = 200
.Visible = True
.Enabled = True
.AddItem “November 2006″, 1
.AddItem “December 2006″, 2
.AddItem “January 2007″, 3
.AddItem “February 2007″, 4
.AddItem “March 2007″, 5
.ListIndex = 1
‘.OnAction = “‘” & ThisWorkbook & “‘!SubName”
End With
End Sub

_____________________

The customised Cell command bar will appear like this:

Remember to reset the Cells command bar when you deactivate the worksheet and the workbook:

_____________________

Private Sub Worksheet_Deactivate()

CommandBars(“Cell”).Reset
CommandBars(“Cell”).Enabled = True

End Sub

_____________________