SELECT CASE Statement

Select Case Statement

The Select Case statement can only be used in VBA, and is very similar to an if-then-else statement in other languages. It is great for use with an option box where a user can select one of many options and then click a button to perform an action, open a form, etc. It is also very useful in other instances. The Select Case statement holds the value or expression to be evaluated. The lines of Case " " statements are conditions that are compared to the select case value. If one of these conditions is true, then the code below will execute.

This example uses a button that is clicked by a user when they want to view a completed purchase order. The Select Case is looking at a listbox that is located on a form. If the 8th column of the listbox (listbox columns always start at 0), has a order status equal to any of the below conditions (open, requested, issued, hold, cancelled....) the associated code will execute.

For example if that order status of the item selected in the listbox is Issued, then 
frmReceiving_View will open.


Private Sub btnReceiving_Click()

Select Case Forms!frmMain!lstbx_Lookup.Column(7)

Case "Open"
MsgBox "Receiving detail not available until PO is issued."
Exit Sub

Case "Requested"
MsgBox "Receiving detail not available until PO is issued."
Exit Sub

Case "Issued"
DoCmd.OpenForm "frmReceiving_View"

Case "Partial"
DoCmd.OpenForm "frmReceiving_View"

Case "Complete"
DoCmd.OpenForm "frmReceiving_View"

Case "RFQ"
MsgBox "Receiving detail not available until PO is issued."
Exit Sub

Case "HOLD"
DoCmd.OpenForm "frmReceiving_View"

Case "Cancelled"
MsgBox "Receiving detail not available when PO is cancelled."
Exit Sub

End Select

End Sub


Is, To, Comma Delimited, and CASE Else

This statement sets value of a string variable based on a form on a field called "age". If [AGE] is equal to any of the case statements then the strAgeGroup variable will be set. Otherwise strAgeGroup will be set to "Other". You can see that the select case statement uses the Is keyword, To Keyword, and commas to delimited values associated with case.

SELECT CASE  [age]

Case Is < 3
     strAgeGroup = "Toddler"

Case 3 to 9
     strAgeGroup = "Child"

Case 10,11,12,13
     strAgeGroup = "Tween"
Case 14 to 17
     strAgeGroup = "Teen"

Case 18 to 25
     strAgeGroup = "Youg Adult"

Case 26 to 64
     strAgeGroup = "Adult"

Case 65 to 110
     strAgeGroup = "Senior"

Case Else
     strOther = "Other"

END SELECT 

Create a report generated by combo box and user input - Access and VBA

So...results are in for another race event and you want to create a report/certificate that any runner can print that will list their name and completed race time. The user should be able to print this report/certificate by typing their name into a textbox and selecting the race/event name from a combobox. This is just an example! Any type of report can be created easily in Access as long as you have the data available and a litte know-how.

1) You need to have at least one table of data imported or created within Access. This tutorial uses MS Access 2010 contains three tables of data. The first is a table called tblBridgeToBrews8k - these are confirmed runners for a race. The second table is tblBridgeToBrews8k_results which contains the results for the runners that participated. The unique identifier for these tables is a field called Race_No. If you know anything about relational databases, you understand that realationships can be created from one table to another using a unique identifier or Primary/Foreign Key. The third table is called tblRaces, and it holds event/race name and date. A field called EVENT_NAME cooresponds with the name of the event and is a primary key of this table. The same field (EVENT_NAME) is in tblBridgeToBrews8k_results.

2)  Create a form. To do this click on the Create tab. In the Forms group, Click on Blank Form- there are other options, but this seems to work the best! A blank form appears on your screen. We will create a form that will contain two combo boxes, and a button. These will allow the user to choose report criteria, and then click to open report.

3) Right click on the Title bar of the form, and click Design View. Your form appears in design mode with a grid like interface.

4) Drag and drop a text box and insert a Title and/or Image onto your form. The textbox and combo box will add next are referred to as Controls. In case this is new for you, controls can be found on the Design tab within the Controls group. Place the textbox as pictured below and use the textbox label to enter Caption: Enter Name. Arrows can be used on the textbox abd textbox label to reposition the control on the form. Click on Property Sheet button on the Design tab in the Tools group to format any control on the form. Click on Title in the Header/Footer group on the Design Tab, nearby is a button to add an image to the from.

5) Next add a combo box control from the Design tab. When you select and place the control on your form a wizard will walk you through populating the combo box. Choose "I want combo box to get values from another table...." Then choose the table or query you will pull data from, what fields you would like to show in the combox box, and if you would like to order the items in the field ascending, etc. Resize or reposition the combo box. The data for this tutorial combo box will be from tblRaces using the field Event Name sorted ascending.



6) Add a label control and give your user directions on how to use the form.

7) Finally drag and drop a button command onto the form. Click Cancel when the macro wizard appears. Use the Property Sheet, All Tab to add a caption to the button and rename the control. I used btnCreate as my button name, and set the caption to "Create Certificate".

8) Final formatting. The Format tab has text and other formatting options.

In Access 2010, the Design tab has a group called Themes. This can help you customize the look and feel of the form, font, colors, etc.

9) Form Properties.

Click to select your form. Go to the Design tab and click on Property Sheet from the Tools group. When the Property Sheet opens make sure Form is selected in the combo box. Change the property values on the listed tab to the following:

FORMAT TAB

Record Selectors - No

Navigation Buttons - No

Scroll Bars - Neither

DATA TAB

Data Entry - Yes

OTHER TAB

Modal - Yes

10) Set the form to open when the Access file opens:

Click on File, Options, and set Display Form to the form in your access database file that you are working on. For this tutorial I chose frmCreateReport.

Here is my completed form:



11) Create a query that will have all the data necessary to populate report certificate.

Click on the Create tab and click on Query Design. Select data tables and create a query. I will select two tables, and create the relationship link between the EVENT_NAME fields.See Below. This lets me bring in matching data from tblRaces. We will set parameters in this query after the report is created. Save the query. mine is called qryReport.

12) Design the Report

Click on the Create tab, and click the Blank Report button. Right click on the title bar and select Design view. Click on the Property Sheet from the Design tab or Report Properties can be accessed on the Design Tab or by right clicking and selecting Report Properties from the menu. Click on the data tab, and find Record Source. Select the qry created in the previous step. This will be your record source for the report.

On the Design Tab, Click on Add Existing Fields - this will open a window with all the fields from the query. They can be dragged and dropped onto the report. Arrange the fields as you wish.

The report can be formatted for color, size, text, images, etc.

Save the report. Mine is called rptCertificate.

13) Set parameters within query

Open the query in Design View. I set parameters on the Name and Event fields. This way whatever the user enters on the form dictates what report/certificate is generated.

See picture. Code Parameters are:

Name: [Forms]![frmCreateReport]![txtName]

Event: [Forms]![frmCreateReport]![cmbEvent]

14) Put Code on form and open Report. -- The final stage!!

Open form in Design view. Right Click on Button, Select Build Event from the pop-up menu, then click Code Builder from the window that opens.

Here is the VBA for the button click event:

Option Compare Database
Option Explicit

Private Sub btnCreate_Click()
DoCmd.OpenReport "rptCertificate", acViewPreview
End Sub

Time to try it out!!

Access 2007 - form with option frame and combo boxes (using Query Def)

A common application created in Access for an end user or an everyday process will require a form, queries, and VBA/ macros, etc.

My task was to create a report which could be printed from a form based on whatever criteria known by the user. The user may want to create reports for all patients for a specific doctor, all doctor's patients for a specific office, or by specific member or patient Id. This can work for any form with combo boxes and/or option frame and option boxes. Here is what I found to work best!

1. Created a report -- This report has a main record source, and 4 additional sub- reports. I found sub-reports are created most easily by dragging and dropping created select queries onto my report in design view.
2.  Created a form - the record source is a query based off basic patient information in this case. Name, DOB, etc. This is the same record source as my report.
3. On the form I dragged an option box. I used the option box wizard to create 3 option boxes. The user will select just 1, based on the type of search they want to make.
4. I added 2 combo boxes, and one text box, and a report preview button. The combo boxes are each filled from a query, the list box is blank, with no default.
5. Then I added the following code to the report preview button_click event. 

Option Compare Database

Option Explicit


Private Sub btnPreview_Click()


'Declare variables
Dim strSQL As String
Dim qdfNew As DAO.QueryDef
Dim db As DAO.Database


Set db = CurrentDb


Select Case Me.FrameOption.Value


Case 1 'Search by doctor
'If combobox Null - msgBox
If IsNull(Me.cmbDoctor) = True Then
MsgBox "Select Doctor for reporting", vbExclamation + vbOKOnly, "Choose Doctor."


Else


'set variable
strSQL = "SELECT Name,"
strSQL = strSQL & " DOB,"
strSQL = strSQL & " NameID,"
strSQL = strSQL & " DrName,"
strSQL = strSQL & " DrPractice"
strSQL = strSQL & " FROM tblInformation"
strSQL = strSQL & " GROUP BY Name, DOB, NameID, DrName, DrPractice "
strSQL = strSQL & " HAVING (((tblInformation.DrName=[Forms]![frmName]![cmbDoctor])) "


End If


db.QueryDefs.Delete ("qryInformation")


Set qdfNew = db.CreateQueryDef("qryInformation", strSQL)
'open report
DoCmd.OpenReport "rptName", acViewPreview




Case 2 'Search by Practice


'If combobox Null - msgBox
If IsNull(Me.cmbPractice) = True Then
MsgBox "Select Practice for reporting", vbExclamation + vbOKOnly, "Choose Practice"
Else
'set variable

strSQL = "SELECT Name,"

strSQL = strSQL & " DOB,"

strSQL = strSQL & " NameID,"

strSQL = strSQL & " DrName,"

strSQL = strSQL & " DrPractice"

strSQL = strSQL & " FROM tblInformation""
strSQL = strSQL & " GROUP BY Name, DOB, NameID, DrName, DrPractice "strSQL = strSQL & " HAVING (((tblInformation.DrPractice=[Forms]![frmName]![cmbPractice])) "


db.QueryDefs.Delete ("qryInformation")
Set qdfNew = db.CreateQueryDef("qryInformation", strSQL)
End If


'open report
DoCmd.OpenReport "rptName", acViewPreview


Case 3 'Search by MemberID
'If textbox Null - msgBox
If IsNull(Me.NameId) = True Then
MsgBox "Enter NameID for reporting", vbExclamation + vbOKOnly, "Enter NameID"


Else


'set variable

strSQL = "SELECT Name,"

strSQL = strSQL & " DOB,"

strSQL = strSQL & " NameID,"

strSQL = strSQL & " DrName,"

strSQL = strSQL & " DrPractice"

strSQL = strSQL & " FROM tblInformation"

strSQL = strSQL & " GROUP BY Name, DOB, NameID, DrName, DrPractice "
strSQL = strSQL & " HAVING (((tblInformation.NameID)=[Forms]![frmName]![txtNameID])) "


End If
db.QueryDefs.Delete ("qryInformation")
Set qdfNew = db.CreateQueryDef("qryInformation", strSQL)


'open report
DoCmd.OpenReport "rptName", acViewPreview

End Select
'removes combobox and textbox values on lose focus

Me.Form.Requery

Me.cmbPractice.DefaultValue = ""

Me.cmbDoctor.DefaultValue = ""

Me.txtNameId.DefaultValue = ""

End Sub

6. I have an option frame with 3 options. I wanted either a combo box or textbox for search criteria available based on the users prefered method to create report. This is the VBA I added to the form Code.

Private Sub OptPractice_GotFocus()
Me.cmbDr.DefaultValue = ""
Me.cmbDr.Visible = False
Me.txtNameId.Visible = False
Me.txtNameId = ""
Me.cmbPractice.Visible = True
Me.lblForm.Caption = "Select Practice Name for Reporting"
End Sub



Private Sub OptDr_GotFocus()
Me.cmbPractice.DefaultValue = ""
Me.cmbPractice.Visible = False
Me.txtNameId.Visible = False
Me.txtNameId = ""
Me.cmbDoctor.Visible = True
Me.lblForm.Caption = "Select Doctor for Reporting"
End Sub




Private Sub OptNameID_GotFocus()
Me.cmbPractice.Visible = False
Me.cmbPractice.DefaultValue = ""
Me.cmbDr.Visible = False
Me.cmbDr.DefaultValue = ""
Me.txtMemberId.Visible = True
Me.lblForm.Caption = "Enter patient name for Reporting"
End Sub

 -- This is a method to create a report based on form criteria using a query def. If you had strictly text boxes -- say where the user was entering report start or end dates -- a simple forms!frmName![TxtbxValue] could be entered into the form recordsource query criteria. Because this form has many options used to create the appropriate report. I chose to use the query def method.. which is amazing!!

VBA: Contact Rolodex - Fun add to customer management database

This idea came from VBA for Dummies book. Contact rolodex that can be created inside any database or as a stand alone database application. This one specifically captures all business, customer, supplier, and company information that is used by a small business. These are the steps I took

1. Created a Multiple Items Form from a tblContacts that I have created (See Design View pic)

2. Customized the form with the fields I wanted to list and buttons on top that link to other database functions. I then added a button with the text Show Details that will take the user to more specific customer information and order history.

3. Added a Option Group box with 27! toggle buttons.

4. I then wrote the VBA code to be fired from a AfterUpdate Event, here it is:

Private Sub Rolodex_AfterUpdate()

'Variable to hold filtered SQL string

Dim strFilterSQL As String

'Set default records source of form

Const strSQL = "SELECT ContactID, ContactTypeID,Company,LastName,FirstName,Phone,Email FROM tblContacts "


Select Case Me.Rolodex


'Filter record source on selected option

Case 1

strFilterSQL = strSQL & "WHERE [Company] Like 'A*' OR [LastName] Like 'A*' ;"

Case 2

strFilterSQL = strSQL & " Where [Company] Like 'B*' OR [LastName] Like 'B*';"

Case 3

strFilterSQL = strSQL & " Where [Company] Like 'C*' OR [LastName] Like 'C*';"

Case 4

strFilterSQL = strSQL & " Where [Company] Like 'D*' OR [LastName] Like 'D*';"

Case 5

strFilterSQL = strSQL & " Where [Company] Like 'E*' OR [LastName] Like 'E*';"

Case 6

strFilterSQL = strSQL & " Where [Company] Like 'F*' OR [LastName] Like 'F*';"

Case 7

strFilterSQL = strSQL & "WHERE [Company] Like 'G*' OR [LastName] Like 'G*' ;"

Case 8

strFilterSQL = strSQL & " Where [Company] Like 'H*' OR [LastName] Like 'H*';"

Case 9

strFilterSQL = strSQL & " Where [Company] Like 'I*' OR [LastName] Like 'I*';"

Case 10

strFilterSQL = strSQL & " Where [Company] Like 'J*' OR [LastName] Like 'J*';"

Case 11

strFilterSQL = strSQL & " Where [Company] Like 'K*' OR [LastName] Like 'K*';"

Case 12

strFilterSQL = strSQL & " Where [Company] Like 'L*' OR [LastName] Like 'L*';"

Case 13

strFilterSQL = strSQL & "WHERE [Company] Like 'M*' OR [LastName] Like 'M*' ;"

Case 14

strFilterSQL = strSQL & " Where [Company] Like 'N*' OR [LastName] Like 'N*';"

Case 15

strFilterSQL = strSQL & " Where [Company] Like 'O*' OR [LastName] Like 'O*';"

Case 16

strFilterSQL = strSQL & " Where [Company] Like 'P*' OR [LastName] Like 'P*';"

Case 17

strFilterSQL = strSQL & " Where [Company] Like 'Q*' OR [LastName] Like 'Q*';"

Case 18

strFilterSQL = strSQL & " Where [Company] Like 'R*' OR [LastName] Like 'R*';"

Case 19

strFilterSQL = strSQL & "WHERE [Company] Like 'S*' OR [LastName] Like 'S*' ;"

Case 20

strFilterSQL = strSQL & " Where [Company] Like 'T*' OR [LastName] Like 'T*';"

Case 21

strFilterSQL = strSQL & " Where [Company] Like 'U*' OR [LastName] Like 'U*';"

Case 22

strFilterSQL = strSQL & " Where [Company] Like 'V*' OR [LastName] Like 'V*';"

Case 23

strFilterSQL = strSQL & " Where [Company] Like 'W*' OR [LastName] Like 'W*';"

Case 24

strFilterSQL = strSQL & " Where [Company] Like 'X*' OR [LastName] Like 'X*';"

Case 25

strFilterSQL = strSQL & " Where [Company] Like 'Y*' OR [LastName] Like 'Y*';"

Case 26

strFilterSQL = strSQL & " Where [Company] Like 'Z*' OR [LastName] Like 'Z*';"

Case 27

strFilterSQL = strSQL & ";"



'If filter applied with no option selected use default record source

Case Else

strFilterSQL = strSQL & ";"

End Select


' Set record source with filtered SQL

Me.RecordSource = strFilterSQL

Me.Requery
End Sub
 
 
Here is the completed form.. with names boxed out, lol... Easy to use, pretty fun little add to an application.
 

DAO VBA: Auto fill customer address within order form

I created a customer and inventory management database for a small business. One function is a product order form. A ContactID(Customer) is chosen from a drop-down menu for each order. After the ContactID is filled, an AfterUpdate event is fired with the following VBA that automatically fills the Contact(customers) shipping address.



Private Sub ContactID_AfterUpdate()


Form.Refresh



Dim FillAddress As String

FillAddress = "Select FirstName, LastName, Address, City, State, Zip "

FillAddress = FillAddress & "FROM tblContacts "

FillAddress = FillAddress & "WHERE ContactID = " & ContactID & ""



Dim db As DAO.Database

Dim rst As DAO.Recordset



Set db = CurrentDb

Set rst = db.OpenRecordset(FillAddress)



Dim FirstName, LastName, Address, City, State, Zip



FirstName = rst![FirstName]

LastName = rst![LastName]

Address = rst![Address]

City = rst![City]

State = rst![State]

Zip = rst![Zip]



If Me.ContactID Then

Me.ShipName.Value = FirstName & " " & LastName

Me.ShipAddress.Value = Address

Me.ShipCity.Value = City

Me.ShipState.Value = State

Me.ShipZip.Value = Zip



End If

End Sub

VBA to compare local and server table

Problem: Server tables have duplicate UserIDs for single entities. I correct this in my local table and then insert a new record into an “Errors” database table called “MoreThanOneUserID”. The table stores all errors, and has a field called Corrected which is formatted as a Yes/No field, another field called LastChecked is also present. I need to find all the new errors and all previous errors that were not corrected and send these to a systems admin for update to Server tables. In order to do this quickly and efficiently I wrote the following VBA code. I tried to add comments so it would be easy to understand. The VBA uses a Make Table Query, Several Update Queries, Recordset, Do…Loop, and ErrorHandler. I have stored the VBA in a module in my local table and have buttons on a form which calls the procedure and then open the respective tables after the procedure is run. I then am able to filter records that are not corrected, and paste or export them into an Excel spreadsheet. I have about 5 different modules that update corrections for different errors. Fun to write..and works, although I wonder if there is an evern better way to do this, I would love some feedback.






Option Compare Database

Option Explicit



Public Sub CheckForUpdate ()



Dim db As DAO.Database

Dim rst As DAO.Recordset

Dim strSQL As String

Dim strSQL1 As String

Dim strSQL2 As String

Dim strSQL3 As String



On Error GoTo ErrorHandler



'Open Current Database

Set db = CurrentDb

db.QueryTimeout = 0



'Make New Table called UserIDUpdate from local and server tables



strSQL = "SELECT”

strSQL = strSQL & " MoreThanOneUserID.UniqueID, MoreThanOneUserID.UserID, MoreThanOneUserID.ServerUserID, MoreThanOneUserID.Corrected"

strSQL = strSQL & " INTO UserIDUpdate "

strSQL = strSQL & " FROM MoreThanOneUserID "

strSQL = strSQL & " WHERE (((MoreThanOneUserID.Corrected Is Null Or (MoreThanOneUserID.Corrected) <> 'Yes')) "



DoCmd.SetWarnings True

DoCmd.RunSQL (strSQL)



'Update ServerUserID in UserIDUpdate Table from data on Server Table



strSQL1 = "UPDATE”

strSQL1 = strSQL1 & " UserIDUpdate INNER JOIN dbo_ServerTable "

strSQL1 = strSQL1 & " ON UserIDUpdate.UniqueID = dbo_ServerTable.UniqueID "

strSQL1 = strSQL1 & " SET UserIDUpdate.ServerUserID = [dbo_ServerTable].[UserID] "

strSQL1 = strSQL1 & " WHERE (((UserIDUpdate.ServerUserID) Is Null)) OR (((UserIDUpdate.ServerUserID)<>[dbo_ServerTable].[UserID])) "



DoCmd.SetWarnings True

DoCmd.RunSQL (strSQL1)



'Update Local ServerUserID from newly created UserIDUpdate Table



strSQL2 = "UPDATE”

strSQL2 = strSQL2 & " MoreThanOneUserID INNER JOIN UserIDUpdate "

strSQL2 = strSQL2 & " ON MoreThanOneUserID.UniqueID = UserIDUpdate.UniqueID "

strSQL2 = strSQL2 & " SET MoreThanOneUserID.ServerUserID = [UserIDUpdate].[ServerUserID]"

strSQL2 = strSQL2 & " WHERE (((MoreThanOneUserID.ServerUserID) Is Null)) OR (((MoreThanOneUserID.ServerUserID)<>[UserIDUpdate].[ServerUserID])) "



DoCmd.SetWarnings True

DoCmd.RunSQL (strSQL2)



'Open Current DB Recordset



strSQL3 = "SELECT”

strSQL3 = strSQL3 & " Trim([UserID]) AS strUserID, Trim([ServerUserID]) AS strServerUserID, MoreThanOneUserID.Corrected, MoreThanOneUserID.LastChecked "

strSQL3 = strSQL3 & " FROM MoreThanOneUserID "

strSQL3 = strSQL3 & " WHERE (((Trim([ServerUserID])) Is Not Null) AND ((MoreThanOneUserID.Corrected) Is Null Or (MoreThanOneUserID.Corrected)<>'Yes'))"



Set rst = db.OpenRecordset(strSQL3)



'If strUserID=strServerUserID then update Corrected field = "yes", otherwise LastChecked = CurrentDate



'Check for records, EOF = End of Field



If rst.EOF Then

MsgBox "No records exist in recordset", vbExclamation, "VB Module Exit"

Exit Sub

Else

rst.MoveFirst

End If



Do While Not rst.EOF

Dim strUserID, strServerUserID As String



‘Set string equal to recordset or rst values

strUserID = rst!strUserID

strServerUserID = rst!strServerUserID



If strUserID = strServerUserID Then

rst.Edit

rst![Corrected] = "yes"

rst.Update

Else

rst.Edit

rst![LastChecked] = Now()

rst.Update

End If



rst.MoveNext



Loop



rst.Close



MsgBox "Corrected UserIDs Marked", vbInformation, "Finished!"



Finish:

Set rst = Nothing

Set db = Nothing



Exit Sub



ErrorHandler:

MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description

'Clear error after processed

Err.Clear

End Sub

30 Free Programming books

Spotted this blog off an online newsletter I receive.

Don't we live in an awesom day in age.. where we can find everything so much information on whatever subject we please...

Here's the link for  30 free programming eBooks

I'd like to check out ruby and a few others...

Access 2007: Using VBA recordsets ~DAO

VBA: Visual Basic for Applications (Microsoft)
Recordset: Dataset that consists of group of database records http://en.wikipedia.org/wiki/Recordset
DAO: Data Access Objects  vs. ADO: Microsoft ActiveX Database Objects

I keep trying to automate different processes at work. The fun/hard part is that I am new to my job and I really have to understand the process and look two or three (or five or six) times at the table names I want to use and the links I need to put between tables. I find I've been using recordsets a lot. They are fun but I seem to finish my code only to have things break, then I repair, and even when it works I think.. there has to be a BETTER WAY!! :) If anyone knows a site or online program I'd love to walk through a couple recordsets or learn other ways to accomplish my same task. The good thing is i'm getting much more familar with VBA recordsets.. and its FUN!

Best thing ever F8, for stepping through each line of code. Sometimes I run the code and it takes me straight to the error... but when I use F8 I can go line by line and see where my error was.


I'll post code sometime soon!

Excel Function with VBA - Sum cells with background color

Ever wanted to sum cells you have highlighted with a background color? If so, follow these steps:

Open Excel 2007 spreadsheet
Press alt +F11
Click Insert from menu, Select Module
Insert the below VBA code and then close the VBA view
Select cell in your spreadsheet
Enter the following formula -  =SumColor(A1:A33,6)
Your formula will be different based on the range of cells you are working with - Ex: A1:A33 and the background color you would like to add.
Background colors are:
Black = 1, White = 2, Red = 3, Green = 4, Blue = 5, Yellow = 6



Code:
Option Explicit


Function SumColor(Area As Range, Ci As Integer)


Dim sng As Single, rng As Range


For Each rng In Area


If rng.Interior.ColorIndex = Ci Then sng = sng + rng.Value


Next rng


SumColor = sng


End Function