We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now


Color Rows On Form

Mithrinder asked
Medium Priority
Last Modified: 2012-06-21
Hello Experts,

I have a form with 3 List Boxes on it.  One of these list boxes has 3 columns of which I would like to either have the entire line or one of the columns seperately display different colors.

I have read through many posts so I am familiar with the fact that this can not be done with a list box directly.

I was hoping for something without having to resort to either a 3rd party control or building an atom bomb to squash an ant.  I have looked at the control at http://www.lebans.com but I would prefer to stick to standard controls if possible.

My first thought was to hide one column that I do not have any events triggered out of and use a subform to display the information on top of the hidden column and hopefully that way I could use the conditional formatting thing to individually set up the colors of the lines in the one column.

Maybe it is because I have not dealt much with subforms but initially Access 2000 complained you could not have a subform on a form set to continuous so I set the main form to single view and was planning to set the subform to continuous so I could use it but I do not see anywhere I can do that and the conditional formatting is greyed out if I try selecting the subform and choosing it.

The column I want to color is text, and all I want to do is change the background color of each record in that column individually....What a hassle this has been for something that seems so simple on the surface...

Hope you all can come up with a solutions out there.

Watch Question

Most Valuable Expert 2012
Top Expert 2013

>if I try selecting the subform and choosing it....
Try right-clicking on the edge of your subform and selecting "Subform In New Window"

You should be able to set properties such as continuous form view from here.  You can also apply conditional formatting byselecting the specific control that you want to format and go to Format -> Conditional formatting...

Take a look at Simulate Combobox in http://www.thenelson.name/#ReportFormTricks 
Try this, works in MS Access 97, 2000 & XP

Private Sub Form_Load()
   blRet = fCreateDib(Me)
   Me.TimerInterval = 0
   blRet = fHighlightAlternateRows(Me)

End Sub

Create a new Module called modConColor, paste all below into module
Alter ' Set colors section in Public Function fCreateDib
Change B, G, R numbers in First & Second Color

Option Compare Database
Option Explicit

Private Declare Sub apiZeroMemory Lib "kernel32" _
    Alias "RtlZeroMemory" _
    (destination As Any, _
    ByVal length As Long)

Private Declare Sub apiFillMemory Lib "kernel32" _
    Alias "RtlFillMemory" _
    (destination As Any, _
    ByVal length As Long, _
    ByVal achar As Byte)

Private Declare Sub apiCopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (destination As Any, _
    Source As Any, _
    ByVal length As Long)
Private Type BITMAPINFOHEADER '40 bytes
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type

Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type

Private Declare Function apiGetDeviceCaps Lib "gdi32" _
          Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _
        (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
        ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function apiDeleteDC Lib "gdi32" _
          Alias "DeleteDC" (ByVal hdc As Long) As Long

' Number of pixels per logical inch along the screen height.
Private Const LOGPIXELSX = 88

' Width and height, in pixels, of the screen of the monitor.
Private Const LOGPIXELSY = 90

' DIB color table identifiers
Private Const DIB_RGB_COLORS = 0

' Color table in RGBs
' constants for the biCompression field
Private Const BI_RGB = 0&
' Remember, 2 RGB quads of palette info
' Plus the 40 bytes of the BITMAPINFOHEADER
' are at the start of the Form's PictureData prop
Private Const LENDIBHEADER = 48

' Need this to optimize code
' Very expensive any time we have to access PictureData prop
Private lngLenPictureData As Long

' Total Rows displayed in Detail Section
' Includes any partially visible rows
Private lngNumRows As Long

' Height of Detail Section in Pixels
Private lngDetailHeightPixels As Long

' Height of last Detail Row. May be a
' partially displayed Row.
Private lngLastDetailRowHeight As Long

' Height of Header if any
Private lngHeaderHeightPixels As Long

' Height of Footer if any
Private lngFooterHeightPixels As Long

' These properties may or may not exist.
' Store values for use in different functions.
Private lngTwipsHeader As Long
Private lngTwipsFooter As Long

'Purpose   : This function clears the PictureData property of our Form. It resets the background picture
'            of our Form to the Background Color we specified in the FCreateDib function.
'Calls     :
'Called by :
Public Function fClearDetail(frm As Form)
On Error GoTo Clear_Error
Dim aTemp() As Byte

' Make our array the same size as the Form's PictureData property
' Remember our arrays indexes are zero based!
ReDim aTemp(lngLenPictureData - 1)

' Copy the Form's PictureData prop to our array.
aTemp = frm.PictureData

' We're clearing the actual bitmap data so we need to fill with WHITE which is Background or &H0
' Our starting address into our Array is offset by LENDIBHEADER bytes. This is 48 bytes and corresponds to
' 40 byte BITMAPINFOHEADER and 8 bytes of 2 RGBQUAD structures.
Call apiFillMemory(aTemp(LENDIBHEADER), lngLenPictureData - (LENDIBHEADER), &H0)  '&HFF)

' Save our changes back to the Form's
' PictureData Property
frm.PictureData = aTemp

' Error handler here
End Function

'Purpose   : This is the main function. Here we ascertain the size of the current Detail section and the Form Header if any.
'            We create an array of bytes to hold the information required to build a compatible PictureData property.
'            We then copy this array into the Form's PictureData property.
'Calls     :
'Called by :
Public Function fCreateDib(frm As Form) As Boolean

Dim sngTemp2 As Single
Dim sngTemp As Single
Dim lngTemp As Long
Dim lngRet As Long
Dim strTemp As String

' Byte array to hold PictureData property
' which is a packed DIB.
' (D)evice (I)ndependant (B)itmap
Dim aPic() As Byte

' Size of the actual Bitmap Data
Dim lngSizeImage As Long

' Detail Section Height in TWIPS
Dim lngDetailHeight As Long

' Detail Section Width in pixels
Dim lngDetailWidth As Long
Dim lngDetailWidthPadded As Long

' Calculate number of rows being displayed
' in Detail Section

With frm
' Save off Height of 1 full Row of the Detail Section in Pixels
lngDetailHeightPixels = fTwipstoPixels(.Section(acDetail).Height)

' Initialize variables for Header and Footer if any
' Need on Error Resume Next because these
' Sections/Props may not exist and will cause Runtime error
On Error Resume Next

lngHeaderHeightPixels = .Section(acHeader).Height
lngHeaderHeightPixels = Nz(lngHeaderHeightPixels, 0)
lngTwipsHeader = lngHeaderHeightPixels
lngHeaderHeightPixels = fTwipstoPixels(lngHeaderHeightPixels)

lngFooterHeightPixels = .Section(acFooter).Height
lngFooterHeightPixels = Nz(lngFooterHeightPixels, 0)
lngTwipsFooter = lngFooterHeightPixels
lngFooterHeightPixels = fTwipstoPixels(lngFooterHeightPixels)

sngTemp = .InsideHeight - (lngTwipsHeader + lngTwipsFooter)

sngTemp = sngTemp / .Section(acDetail).Height
' Truncate - discard fraction
sngTemp2 = Fix(sngTemp)

' Get Fraction if any
sngTemp2 = sngTemp - sngTemp2
If sngTemp2 > 0 Then
    lngLastDetailRowHeight = (sngTemp2 * .Section(acDetail).Height)
    lngLastDetailRowHeight = fTwipstoPixels(lngLastDetailRowHeight)
    ' Total Rows in Detail Section. If there is a
    ' partial Row visible we count this as a row)
    lngNumRows = Fix(sngTemp) + 1
    lngNumRows = Fix(sngTemp)
    lngLastDetailRowHeight = lngDetailHeightPixels
End If

' Calculate Detail Section Height and Width in Pixels
' Width is straightforward
lngDetailWidth = .InsideWidth

' Height is more complicated.
' We need to take the overall Window Height and subtract the height of the Footer.
' We need to leave the Header in the calculation because we can only specify the position of
' the bitmap indirectly. In our case we are using TOP LEFT as the Picture Alignment Prop.

'lngDetailHeight = Nz((frm.Section(acHeader).Height), 0)
lngDetailHeight = lngDetailHeight + lngTwipsFooter
lngDetailHeight = .InsideHeight - lngDetailHeight

End With

' Resume normal error processing - or lack thereof :-)
On Error GoTo CreateDib_Error

' OK, lets convert our TWIP values to PIXELS
lngDetailWidth = fTwipstoPixels(lngDetailWidth)
lngDetailHeight = fTwipstoPixels(lngDetailHeight)

' Calculate the size of our BitMap data
' Remember each line must begin on a 32 bit address
' Force alignment to - 32  pixels for Access monochrome bitmap
lngDetailWidthPadded = ((lngDetailWidth + 31) And &HFFFFFE0)
lngDetailWidthPadded = lngDetailWidthPadded \ 8
' Round up width to an even number if required

' Size = Number pixels wide / 8 bits/pixels per byte + padding
' times the total number of lines high
lngSizeImage = lngDetailWidthPadded * lngDetailHeight

bh.biBitCount = 1
bh.biSize = 40
bh.biWidth = lngDetailWidth
bh.biHeight = lngDetailHeight
bh.biPlanes = 1
bh.biBitCount = 1
bh.biCompression = BI_RGB
bh.biSizeImage = lngSizeImage
bh.biXPelsPerMeter = 0
bh.biYPelsPerMeter = 0
bh.biClrUsed = 2
bh.biClrImportant = 0

' Redimension our array to newly calculated size.
ReDim aPic(lngSizeImage + (LENDIBHEADER - 1))

' Copy our BITMAPINFOHEADER into aPic array
apiCopyMemory aPic(0), bh, 40

' Set colors
' Grey(192,192,192) is standard Access Grey
'First Color
aPic(40) = 245 '255 'B
aPic(41) = 219 '255 'G
aPic(42) = 238 '255 'R
aPic(43) = 0        'Unused

' Second Color
aPic(44) = 245   'B
aPic(45) = 187   'G
aPic(46) = 227 'R
aPic(43) = 0   'Unused

' Initialize all of the Form's Picture Properties required to specify that we have loaded a picture
' as the Form's background.

' Our Constructed packed DIB
frm.PictureData = aPic

' Top Left = 0
frm.PictureAlignment = 0

' Clip = 0
frm.PictureSizeMode = 0

' Embedded = 0
frm.PictureType = 0

' No Tiling
frm.PictureTiling = False

' Return total length of PictureData prop
' Trying to optimize code so we don't have to continually calculate this value
lngLenPictureData = lngSizeImage + LENDIBHEADER

fCreateDib = True

' We want to make sure our function is called the first time the Form is displayed. AbsolutePosition must not be equal to zero.
' Need error checking if no records.
frm.RecordsetClone.AbsolutePosition = frm.RecordsetClone.RecordCount

fCreateDib = True
Exit Function

'MsgBox "ERROR:Unable to Create Bitmap!"
fCreateDib = False
End Function

'Purpose   :
'Calls     :
'Called by :
Public Sub DrawBackGround(frm As Form, ByVal X As Long, _
ByRef arrRows() As Long)

' For this example we are always using a 1 bit DIB.
' As we are simply drawing a rectangle we do
' not need to use the API Graphics Library.
' We'll do it the old fashioned way by
' setting the bytes/bits/pixles directly.

' This current version is not using the X parameter.
' It is not required since we are always
' drawing a rectangle from the start of the left
' edge of the Detail Section. I have included the beginnings
' of the logic required to allow for variable X parameters
' so that we can highlight individual controls.
' We would need starting and ending X coordinates.
' Additionally, the routines that currently draw a simple
' rectangle would have to be enhanced to recognize
' variable  starting and ending points.
' It won't take much more coding to do these things! :-)


' Bunch of temporary variables
Dim lngX As Long
Dim lngY As Long
Dim lngTempX As Long
Dim lngTempY As Long
Dim lngRet As Long
Dim lngPixel As Long

' Array o fbytes to hold our PictureData property
Dim lngBuff() As Byte

Dim intCounter As Integer
Dim lngCurpixel  As Long

Dim lngPaddingX As Long
Dim lngDetailWidthPadded  As Long

' Redim our array to hold all of the PictureData prop
ReDim lngBuff(lngLenPictureData - 1)

' transfer DIB to array to work on directly
lngBuff = frm.PictureData

' Fill in our temp BITMAPINFOHEADER struct so we can get at the dimensions and size of our bitmap
apiCopyMemory bh, lngBuff(0), 40

' Calling program sends array of literal row numbers from 1 to lngNumRows that we are to print.
' Here is the original logic to calculate the Y offsets. Simply add the Form Header(if any)
' plus the DetailHeight times the row number

' Calculate the size of our BitMap data
' Remember each line must begin on a 32 bit address
lngDetailWidthPadded = ((bh.biWidth + 31) And &HFFFFFE0)
lngDetailWidthPadded = lngDetailWidthPadded \ 8

For intCounter = 0 To (UBound(arrRows)) Step 1

' Always Zero for now
lngX = X

lngY = lngHeaderHeightPixels + (lngDetailHeightPixels * arrRows(intCounter))

' Now we need to calulate offset in the Image control's PictureData byte array to set the proper bit
' Remember - it's upside down!!!!

lngTempY = lngY * lngDetailWidthPadded

If lngX > 0 Then
lngTempX = lngX / 8 '
End If
lngPixel = lngTempY - lngTempX

' Reverse it by subtracting from end of variant
lngPixel = lngLenPictureData - lngPixel

' We are always subtracting since DIB is upside down.
' If Total bytes that we are going to process is greater than the starting position then there is an error
If lngPixel < (LENDIBHEADER + (lngDetailWidthPadded * lngDetailHeightPixels)) Then
   lngPixel = (LENDIBHEADER + (lngDetailWidthPadded * lngDetailHeightPixels))

End If
' We are always subtracting since DIB is upside down.
' If starting position is greater than the total length then we have an error
    If lngPixel > lngLenPictureData - 1 Then
        lngPixel = lngLenPictureData - 1
    End If

lngTempX = 1

    If lngLastDetailRowHeight <> lngDetailHeightPixels Then
        If arrRows(intCounter) = lngNumRows - 1 Then
    ' We need to change Detail height to reflect this partially obscured row.
    ' Our new improved API driven SLDrawRectangle
    apiFillMemory lngBuff(lngPixel - _
    (lngDetailWidthPadded * lngDetailHeightPixels)), lngDetailWidthPadded * lngLastDetailRowHeight, &HFF
        lngTempX = 0
        End If
    End If

   If lngTempX <> 0 Then
    apiFillMemory lngBuff(lngPixel - _
    (lngDetailWidthPadded * lngDetailHeightPixels)), lngDetailWidthPadded * lngDetailHeightPixels, &HFF
    End If

Next intCounter

' Save our changes back to the Form's
' PictureData property
frm.PictureData = lngBuff

End Sub

'Purpose   :
'Calls     :
'Called by :
Public Function fCallGetScrollInfo(frm As Form) As Boolean
' This is the function called directly by the Form's Timer event.
' We make our 1 quick function call to fScrollTheForm and exit if:
' The Top Row of the Form and the CurrentRecord have not changed since the last Timer event.

' Junk temp variables
Dim strTemp As String, strTemp1 As String
Dim X As Long, Y As Long
Dim lngTemp As Long

' added by Bill Murphy
Dim strTest As String    ' test added 2/22/01
Dim lngSaveAbsolutePosition As Long   ' added 2/24/01 to restore position to top row

' The Row that is currently displayed as the top row of our Form.
Dim lngTopRow As Long

' Holds which Rows we want to print
Dim arrWhichRows() As Long

' Make our API calls  to get the current position of the Form's ScrollBar which yields the Top Row currently displayed in the Form.
lngTopRow = fScrollTheForm(frm)

' Check and see if Top Row has changed since the last call!
If lngTopRow = frm.RecordsetClone.AbsolutePosition Then
    ' No Change. Let's exit function so we are not tying up system resources when the user is not moving around in the Form.
    Exit Function
End If

' OK clear our Form's Background Picture
Call fClearDetail(frm)

With frm
    .RecordsetClone.AbsolutePosition = lngTopRow
    .txtTopRowCode = .RecordsetClone!Code
    .txtTopRow = .RecordsetClone.AbsolutePosition + 1
    fCallGetScrollInfo = .RecordsetClone.AbsolutePosition
    ' added by Bill Murphy
    lngSaveAbsolutePosition = lngTopRow  ' needed for restore below

    ' temporarily disable scrolling if number of records less than number of rows on form - added by Bill Murphy
    If .RecordsetClone.RecordCount < lngNumRows Then
        .ScrollBars = 0   ' neither
        .ScrollBars = 3   ' both
    End If
    ' Turn off Form Painting
    .Painting = False

    strTemp = ""
    strTest = ""    ' added by Bill Murphy
    ' AbsolutePosition is ZERO based
    lngTopRow = lngTopRow + 1
    ' initialize row counter
    X = 0
    Y = 0

    For lngTopRow = lngTopRow To (lngTopRow + (lngNumRows - 1))
        If lngTopRow - 1 <= .RecordsetClone.RecordCount Then
            .RecordsetClone.AbsolutePosition = lngTopRow - 1
            ' added by Bill Murphy
            If IsNull(.RecordsetClone!testcolumn) Then
                strTest = "Skip"
                strTest = .RecordsetClone!testcolumn
            End If
                strTest = "Skip"
        End If
        ' added by Bill Murphy
        If strTest = "Stephen" Or strTest = "Lebans" Then
            strTemp1 = strTemp1 & str(lngTopRow) & ":"
            ReDim Preserve arrWhichRows(X)
            arrWhichRows(X) = Y
            X = X + 1

        End If
        strTest = ""

        Y = Y + 1
    ' restore absolute position in recordset to top row of form
    .RecordsetClone.AbsolutePosition = lngSaveAbsolutePosition

    ' Verify there is at least one entry in the Array
    On Error Resume Next
    X = -1
    X = (UBound(arrWhichRows))
    If X >= 0 Then
        Call DrawBackGround(frm, 0, arrWhichRows())
    End If
    ' Turn ON Form Painting
    .Painting = True

    ' Update our Display on Form
    .txtPosition = strTemp1
End With

' Return TRUE for Success!
fCallGetScrollInfo = True

' Uhh. where's the error handler?
End Function

'Purpose   : This function is basically the same as the fCallGetScrollInfo function above.
'            We are using this function to check and see what the CurrentRecord is and if the
'            Form has been scrolled so we need to Repaint the CurrentRecord as it scrolls Up/Down.
'            This is the function called directly by the Form's Timer event.
'            We make our 1 quick function call to fScrollTheForm and exit if:
'            The Top Row of the Form and the CurrentRecord have not changed since the last Timer event.
'Calls     :
'Called by :
Public Function fScrollInfoCurrentRecord(frm As Form, blReset As Boolean) As Boolean

' Junk temporary variables
Dim strTemp As String, strTemp1 As String
Dim X As Long, Y As Long
Dim lngTemp As Long

' Top Row currently displayed in the Form.
Dim lngTopRow As Long

' Holds which single Current Row we want to print
Dim arrWhichRows(0) As Long

' We use this variables to test and see if we need to update our display or quickly exit this Timer event!
Static lngPrevTopRow As Long
Static lngPrevCurrentRecord As Long

' blReset was needed to FLAG that the user has selected HighLight CurrentRecord from the multiple choice "Format Type" Frame control.
If blReset Then
    ' We are switching from Format.Criteria or Format.Alternate
    ' Initialize Static vars
    lngPrevTopRow = -1
    lngPrevCurrentRecord = -1
End If

' We only want to clear bitmap once after we scroll our current row/record off the screen
Static blFlagClearBitmap As Boolean

' Make our API calls to get the current position of the Form's ScrollBar
' which yields the Top Row currently displayed in the Form.
lngTopRow = fScrollTheForm(frm)

If lngPrevTopRow = lngTopRow Then
    If lngPrevCurrentRecord = frm.CurrentRecord Then
        Exit Function
    End If
End If

' Update our Static variables so that we can use our testing logic on
' entry to this function to see if an update is required or not
lngPrevTopRow = lngTopRow
lngPrevCurrentRecord = frm.CurrentRecord

' AbsolutePosition is ZERO based index.
lngTopRow = lngTopRow + 1

' If Current Row is not currently displayed then exit
' Is the CurrentRecord above the  Record in the Top Row
If frm.CurrentRecord < lngTopRow Then
    If blFlagClearBitmap = True Then
        Call fClearDetail(frm)
        blFlagClearBitmap = False
    End If
    Exit Function

End If

' If Current Row is not currently displayed then exit.
' Is the CurrentRecord Below the Record at the Bottom Row
If frm.CurrentRecord >= lngTopRow + lngNumRows Then
    If blFlagClearBitmap = True Then
        Call fClearDetail(frm)
        blFlagClearBitmap = False
    End If
    Exit Function

End If

' OK clear our Form's Background bitmap
Call fClearDetail(frm)

With frm
    fScrollInfoCurrentRecord = .CurrentRecord

    ' Set flag - Bitmap is painted
    blFlagClearBitmap = True

    ' Turn off Form Painting
    .Painting = False

    strTemp = ""
    ' initialize row counter
    X = 0
    Y = 0

    X = frm.CurrentRecord - lngTopRow
    arrWhichRows(0) = X
    Call DrawBackGround(frm, 0, arrWhichRows())

    ' Turn ON Form Painting
    .Painting = True
End With

fScrollInfoCurrentRecord = True

' Uhh..where's the Error handler?
End Function

'Purpose   : This functions Draws Highlighting rectangles on alternate rows.
'Calls     :
'Called by :
Public Function fHighlightAlternateRows(frm As Form) As Boolean

' Junk variables
Dim lngRet As Long
Dim X As Long
Dim Y As Long

' Array to hold our PictureData Property
Dim arrTemp() As Long

' Clear the Form's Background
Call fClearDetail(frm)

' We want to specify every other row!
For X = 0 To lngNumRows - 1 Step 2
    ReDim Preserve arrTemp(X)
    arrTemp(Y) = X
    Y = Y + 1

' Draw a rectangle every other row!
Call DrawBackGround(frm, 0, arrTemp())

fHighlightAlternateRows = True
'  Missing error handler again.
End Function

'Purpose   :
'Calls     :
'Called by :
Public Function fTwipstoPixels(ByVal tw As Long) As Long
Dim lngXdpi As Long
Dim lngIC As Long
    lngIC = apiCreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)
    'If the call to CreateIC didn't fail, then get the Screen X resolution.
    If lngIC <> 0 Then
        lngXdpi = apiGetDeviceCaps(lngIC, LOGPIXELSX)
        'Release the information context.
        apiDeleteDC (lngIC)
        ' Something has gone wrong. Assume an average value.
        lngXdpi = 120
    End If
    fTwipstoPixels = tw / (1440 / lngXdpi)
End Function

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts


mbizup - In order to use the conditional formatting I have read that it requires the subform to be set to continous mode.  Sooo my main form is now set to single view, it was previously set to continous.  This allows me to now drop the subform on to the form but there is still no way to set the subform to continous, so the conditional formatting is still greyed out.  I can not get the open the subform in a new window menu buy right clicking anywhere on any edge so I am not sure what is up with that.  Am I missing something here?  I would think a subform is a new form dropped onto an existing form right?  I am selecting subform/subreport from the toolbox and drawing a box on my main form  and dropping it down.  The main form has the three list boxes on it.  

thenelson- Thanks for the info but I do not see how that helps me?

RonOsborne- Well I don't know where to even start with that one...I did mention atom bomb I would say that qualifies here...
Most Valuable Expert 2012
Top Expert 2013

Another approach would be to open your subform in design view from the database window (on its own, not with the main form) and setting it's default view property to "Continuous Forms".   Also set up the conditional formatting at this time.  Get these properties set prior to "dropping" it on the main form.
Yep, why use a hammer when you can use an atom bomb
It may be old code, but it works, just plug it in and use it, 1 module and 3 lines of code on any continuious form
It hasn't failed since 1995 in thousands of users sites and thier various configurations of Windows OS and Access (just had to toot my own whistle)
Good luck with which ever way you go


mbizup, thenelson, ronosborne and anyothers.

See the form BuyLimitHighTick in the sampledatabase I put together.  You can retrieve the form and supporting tables/queries at:


Optimally I would like to be able to change an entire row in HTList0 but I would settle for just making a record in the symbol column Green if the correct conditions were present.

I would even accept some other standard control along side the symbol which could be color coded with HTList0 as it's source.


ronosborne - I certainly don't have anything against old code...  I am just not sure I understand how to apply it to my case.  Can I somehow use this to repaint the background color of any single line in the form HTList0 which is a sample of my form.
I created a subform with conditional formatting for you at  www.thenelson.name/ListBoxForms.mdb
Not knowing the criteria you wanted for the conditional formatting, I just made it based on HighTickCount > 10

If you want a double click function for the row you click on, just add a double click event fire each control.


thenelson - Thanks so much for providing me with that form that was all I needed...spent the entire day redoing my trading screen to make the entire thing a subform.  I think I got it all working....we will see tomorrow!

I have opened a followup question for you at http://www.experts-exchange.com/Databases/MS_Access/Q_21785356.html please respond to that so I can award you another 500 points for answering several questions in one.

Glad to help.

Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.


Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.