Where are all the experts? VBA Help Required

A

Andy

Here is what I need to do, just need to tie it all in with VBA for Excel
from within Access

I export my data into an excel spreadsheet, autofilter and arranfge column
widths, then e-mail to an exchange folder, all from VBA

I now want to also colour code the rows depending on the value in one of the
columns.

1) Determine number of rows to be placed on excel (this should equate to
number of records + 1)
dim reccount
reccount = DCount("ID", "Inventory")


2) For correctness, discount row1 (this is a heading row)
Just start from D2


3) select range D2 to Dx (column D has required value)
use a loop D2 to reccount


4) could possibly use loop and case to determine value of cells
if Planning found in cell dx, colour the row in blue, if Engineers found,
colour red, or leave uncoloured if neither value found

e.g.

dim Counter
For Counter = 2 To reccount Step 1
If Not IsError(.Value) Then
Select Case .Value
Case "Planning"
.Interior.ColorIndex = 45
Case "Engineers"
.Interior.ColorIndex = 20
End Select
End If
Next Counter

or

Sub Check_Range_Value()
Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("D2:D" reccount)

For Each rnCell In rnArea
With rnCell
If Not IsError(.Value) Then
Select Case .Value
Case "Planning"
.Interior.ColorIndex = 45
Case "Engineers"
.Interior.ColorIndex = 20
End Select
End If
End With
Next

End Sub

Here is my current code, just need to know how to colour the row, not just
the cell and where to put it in my existing code (below)
---------------------
Private Sub Form_Load()
Dim delFile
On Error Resume Next
delFile = "c:\inventory.xls"
DoCmd.SetWarnings False
Kill delFile

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Inventory", "c:\inventory.xls", True
End Sub
---------------------
Private Sub ToExcel_Click()

Dim xl As Object
Set xl = CreateObject("Excel.Application")

Set xlwb = xl.Workbooks.Open("c:\Inventory.xls")
Set xlws = xlwb.Worksheets("Inventory")

xl.Visible = True

With xlws
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
.Cells.Select
.Cells.EntireColumn.AutoFit
Selection.AutoFilter
.Rows("1:1").Select
Selection.Font.Bold = True
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A1").Select
xlwb.Application.ActiveWorkbook.Save
xl.Quit
Set xlws = Nothing
Set xlwb = Nothing

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
..To = "(e-mail address removed)"
..Subject = "Inventory"
..Attachments.Add ("c:\Inventory.xls")
..Send
End With

End Sub
 
G

George Nicholson

Both of your examples are valid approaches, but the 2nd is closer to
working as-is (".Value" in the first example appears to be relying on a
"With...End With" structure that isn't provided). I would suggest the
following 2 modifications to your 2nd example:
Set rnArea = Range("D2:D" & reccount) '(you are missing the
ampersand)
.EntireRow.Interior.ColorIndex = 45 'I believe EntireRow is
what you are looking for

As far as placement, I'd probably insert it after you've set the color of
the Header row, but it really doesn't matter.

HTH,
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top