Calling Code

Spyhunter

Registered User.
Local time
Today, 18:27
Joined
Apr 23, 2010
Messages
86
I have a piece of code that I need to repeat for multiple forms/subforms.

How do I call this from one location, do I use modules etc?
 
it's just a calculation such as;

Code:
Dim Col11, Col12, Col13, Col14, Col15, Col16, Col17, Col18, Col19, Col20, Col21, Col22, Col23, Col24, Col25 As Long
Dim Col26, Col27, Col28, Col29, Col30, Col31, col32, Col33, Col34, ColBlank As Long
    Col11 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 11")
    Col12 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 12")
    Col13 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 13")
    Col14 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 14")
    Col15 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 15")
    Col16 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 16")
    Col19 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 19")
    Col20 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 20")
    Col21 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 21")
    Col22 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 22")
    Col23 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 23")
    Col24 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 24")
    Col25 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 25")
    Col26 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 26")
    Col27 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 27")
    Col28 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 28")
    Col29 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 29")
    Col30 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 30")
    Col31 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 31")
    col32 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 32")
    Col33 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 33")
    Col34 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 34")
    ColBlank = 16777215
Dim i As Integer
Dim did As String
Dim dtop As String
Dim dbottom As String
For i = 1 To 31
     did = "[" & "ID" & CStr(i) & "]"
     dtop = "[" & "Day" & CStr(i) & "LabelTop]"
     dbottom = "[" & "Day" & CStr(i) & "LabelBottom]"
    Select Case Me(did)
    Case 11
        Me(dtop).BackColor = Col11
        Me(dbottom).BackColor = Col11
    Case 12
        Me(dtop).BackColor = Col11
        Me(dbottom).BackColor = ColBlank
    Case 13
        Me(dtop).BackColor = Col13
        Me(dbottom).BackColor = Col13
    Case 14
        Me(dtop).BackColor = Col13
        Me(dbottom).BackColor = ColBlank
    Case 15
        Me(dtop).BackColor = Col15
        Me(dbottom).BackColor = Col15
    Case 16
        Me(dtop).BackColor = Col15
        Me(dbottom).BackColor = ColBlank
    Case 19
        Me(dtop).BackColor = Col19
        Me(dbottom).BackColor = Col19
    Case 20
        Me(dtop).BackColor = Col19
        Me(dbottom).BackColor = ColBlank
    Case 21
        Me(dtop).BackColor = Col21
        Me(dbottom).BackColor = Col21
    Case 22
        Me(dtop).BackColor = Col21
        Me(dbottom).BackColor = ColBlank
    Case 23
        Me(dtop).BackColor = Col23
        Me(dbottom).BackColor = Col23
    Case 24
        Me(dtop).BackColor = Col23
        Me(dbottom).BackColor = ColBlank
    Case 25
        Me(dtop).BackColor = Col25
        Me(dbottom).BackColor = Col25
    Case 26
        Me(dtop).BackColor = Col25
        Me(dbottom).BackColor = ColBlank
    Case 27
        Me(dtop).BackColor = Col27
        Me(dbottom).BackColor = Col27
    Case 28
        Me(dtop).BackColor = Col27
        Me(dbottom).BackColor = ColBlank
    Case 29
        Me(dtop).BackColor = Col29
        Me(dbottom).BackColor = Col29
    Case 30
        Me(dtop).BackColor = Col29
        Me(dbottom).BackColor = ColBlank
    Case 31
        Me(dtop).BackColor = Col31
        Me(dbottom).BackColor = Col31
    Case 32
        Me(dtop).BackColor = Col31
        Me(dbottom).BackColor = ColBlank
     Case 33
        Me(dtop).BackColor = Col33
        Me(dbottom).BackColor = Col33
     Case 34
        Me(dtop).BackColor = Col33
        Me(dbottom).BackColor = Col33
    Case Else
        Me(dtop).BackColor = ColBlank
        Me(dbottom).BackColor = ColBlank
    End Select
Next i

That changes the colour of a box dependent on the user selections. This works but I have to repeat it for a number of forms whereas I want to create an overall link to the code if possible.
 
In a Standard Module:
Code:
Option Compare Database
Option Explicit

Public iColors As Object


Public Function SetColors()
    Dim rst As DAO.Recordset
    
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM Ref_DayType WHERE (ID BETWEEN 11 AND 34) AND ID Not In(17, 18) ORDER BY ID;")
    
    Set iColors = CreateObject("Scripting.Dictionary")
    
    Do While Not rst.EOF
        iColors.Add CStr("col" & rst!ID), CLng(rst!ColorCode)
        rst.MoveNext
    Loop
    
    rst.Close
    Set rst = Nothing
    
End Function


Public Function SetCtlColor(ctl As Control, intID As Long)
    ' ctl is the name of control to set backcolor of
    ' intID is the color ID
    
    If iColors.Exists("col" & intID) Then
        ctl.BackColor = CLng(iColors.Item("col" & intID))
    Else
        ctl.BackColor = 16777215
    End If
End Function

In the Open event of any form:
Code:
Private Sub Form_Open(Cancel As Integer)
    If iColors Is Nothing Then
        Call SetColors
    End If
End Sub

To set the color call it like this:
Code:
SetCtlColor Me.ControlName, Nz(Me.IDControlName.Value, 0)
 
thanks but it errors on the following;

Code:
Public Function SetColors()
    Dim rst As DAO.Recordset

with "User defined type not defined"
 
In VBA editor:

Tools > References >

Microsoft DAO 3.x Object Library
 
thanks, i'll try that now.

just out of interest do you know how to convert a type of field.
I have a date that is double or date (dim)
and i which is integer. I need to take the date field (which is a number) and place into the for i = day to 31 so if I select day 5 it will then add up 5 to 31 under i.

Any suggestions please :)
 
just out of interest do you know how to convert a type of field.
I have a date that is double or date (dim)
I don't understand. It's a Date data type or a Double data type, not both. Date fields should have a data type of Date/Time.

I need to take the date field (which is a number) and place into the for i = day to 31 so if I select day 5 it will then add up 5 to 31 under i.
If you want to add n days to a Date/Time field, you can use the DateAdd() function (if this is what you're asking :confused:)
 
sorry let me try to explain a bit;

I get an invalid use of Null error which I believe is due to the link to the field on another form. This field is a double field that has two digits.

Here is my code that is causing the error;
Code:
Dim TotalHolCalc As Double, TotalSickCalc As Double, TotalELCalc As Double
TotalHolCalc = 0
TotalSickCalc = 0
TotalELCalc = 0
Dim SelectedDay As Double
SelectedDay = [Forms]![Main]![SubTotals]![CurrentMonth]

Dim d As String
Dim i As Integer
'For i = 1 To 31  <<< Original Line
For i = SelectedDay To 31
     d = "[" & "Day" & CStr(i) & "]"
     Select Case Me(d)
          Case "H"
               TotalHolCalc = CDbl(TotalHolCalc + 1)
          Case "H½"
               TotalHolCalc = CDbl(TotalHolCalc + 0.5)
          Case "S"
               TotalSickCalc = CDbl(TotalSickCalc + 1)
          Case "S½"
               TotalSickCalc = CDbl(TotalSickCalc + 0.5)
          Case "EL"
               TotalELCalc = CDbl(TotalELCalc + 1)
          Case "EL½"
               TotalELCalc = CDbl(TotalELCalc + 0.5)
          Case "SH½"
               TotalSickCalc = CDbl(TotalSickCalc + 0.5)
               TotalELCalc = CDbl(TotalELCalc + 0.5)
          Case "HS½"
               TotalSickCalc = CDbl(TotalSickCalc + 0.5)
               TotalELCalc = CDbl(TotalELCalc + 0.5)
     End Select
Next i
TotalHoliday = CDbl(TotalHolCalc)
TotalSick = CDbl(TotalSickCalc)
TotalEL = CDbl(TotalELCalc)

Any suggestions, as the concepot should work - where it grabs the selected day which could equal '10' then counts i from 10 to 31, that way I can total up just the days from 10 to 31.
 
just to add [CurrentDay] is a unbound textbox which has the format 'dd'
Do I need to set this textbox to a certain format?

Could it be that as
SelectedDay As Double
but
i As Integer

So this statement would conflict ;
For i = SelectedDay To 31
 
it's on another form but when i remove the
SelectedDay = [Forms]![Main]![SubTotals]![CurrentMonth]

it stops the error.
 
SelectedDay is declared as Double, it doesn't accept Null values.

So validate for Null before trying to assign that value to the SelectedDay variable. Use IsNull()
 
ok, but what context would i place that in the code, obviously
Code:
SelectedDay = IsNull([Forms]![Main]![SubTotals]![CurrentMonth])
doesn't work!
I understand the concept but not the result yet.

Although I do appreciate your help.
 
Did you have a look in the VBA Help files for an explanation of the IsNull() function?
 
yes but that doesn't help me - it just checks whether its null - i don't understand what I need to do after checking it... so I know its null - doesn't help the end result surely?! Or Am I being think :)
 
Code:
If IsNull([[COLOR=Red]Some field[/COLOR]]) = True Then
      do something
Else
      do something else
End If
 
LOL I was just typing a similar coding, as below;
Code:
If IsNull([Forms]![Main]![SubTotals]![CurrentDay]) = True Then
      SelectedDay = 1
Else
      SelectedDay = [Forms]![Main]![SubTotals]![CurrentDay]
End If
But this doesn't work - my concept was to check whether it was null, if so then just to equal 1 else it would take the day selected.

This would then be used in for i statement, so if null then 1 to 31 else use day to 31.
 
If you're going to use a substitute for Null, then use Nz()

Yet another function to research :)

SelectedDay = Nz([Forms]![Main]![SubTotals]![CurrentMonth], 1)
 
everything i try errors the same;
dayd = IIf(IsNull([Forms]![Main]![SubTotals]![CurrentDay]), 1, 2)

This would supposingly show 1 for null else 2?

(note: I change 'SelectedDay' to be dayd)
 

Users who are viewing this thread

Back
Top Bottom