Placement of function within a Loop statement - Updating Excel wksht from Access (1 Viewer)

K

kfschaefer

Registered User.
Local time
Today, 07:11
Joined
Oct 10, 2008
Messages
58
I have a group of code that will update multiple Worksheets within an Excel Workbook and then format the cells according to data within the Excel Cells. from Access Vba

The problem I am having is where to place the 2 function to update the formatting of the cells on the 2 separate worksheets accordingly.

The results I am looking for are as follows:

Populate the wksht(s) with appropriate data, then based on the listbox selection from activation form. The code to update the data within the worksheets works great it is just the formatting that is not recognizing which wksht to update.

See '<<<<<<<<<<<<<<<< within the code and the code for the functions follow
ie.

if gwsht = "Enterprise_ACS" then
Formatting_ACS
Elseif gwksht = "Enterprise_INFSTR" then
Formatting_INFSTR
end if

When I attempt to create an If statement to look at the name of the wksht, the function activates corrrectly, however, it does not like the Set wksht = Worksheet("Enterprise ACS") portion of my function,. And if I keep the calling of the functions outside of the loop then it only updates the 2nd wksht and has no issues with the above mentioned line of code.

Where would you recommend I place this code so that the formatting will happen at the appropriate time and both worksheets are updated and formatted correctly?

Pleae note that If I can eliminate the 2 additoinal functions for formating and replace it with one it would be great See FormatWS. The current problem with this bit of code is the establishing of the worksheet to be formatted or to make each one active at the appropriate time. Any IDEAS would be greatly appreciated.

Thanks,

Karen
Code: 
Private Sub cmdExportToExcel_Click()
On Error GoTo ProcError

'For Late Binding
'   Dim xlApp As Object
  
'For Early Binding
    Dim xlApp As Excel.Application
    Dim rs As DAO.Recordset
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim strDataArray() As String
    Dim strSQL As String
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim strFolder As String
    Dim strFileName As String
    Dim i As Integer, j As Integer, intRecordCount As Integer
    Dim blnSuccess As Boolean
    Dim gWkSht As String
    Dim nRow As Integer
    Dim bolSwitch As Boolean
    
    StatusMsg Me, ""
    
    strFolder = GetUsersDesktopFolder
    strFileName = strFolder & "2010 FTI-ME Ent-DP.xls"
   'Determines the column headings for the Training Matrix spreadsheet(s)
    strSQL = "SELECT Mid([Ilp Learning Title],1,InStrRev([Ilp Learning Title],'(')-1) AS CourseTitle," & _
                " TL_CourseList.[Ilp Learning Cd] AS CourseNumber, TL_CourseList.[Delv Mthd Tot Hrs] AS Duration," & _
                " TL_SourceTraining.TrainSource AS CourseSource, TL_CourseList.StandardRequiredDt," & _
                " TL_CourseFreq.[Frequency Required]" & _
            " FROM TL_SourceTraining INNER JOIN (TL_CourseList LEFT JOIN TL_CourseFreq ON" & _
                " TL_CourseList.Frequency = TL_CourseFreq.FreqRecID) ON TL_SourceTraining.SourceRecID = TL_CourseList.SourceRecID" & _
            " WHERE (((TL_CourseList.OnXLS) <> 0) And ((TL_CourseList.InActive) = 0))" & _
            " GROUP BY Mid([Ilp Learning Title],1,InStrRev([Ilp Learning Title],'(')-1), TL_CourseList.[Ilp Learning Cd]," & _
                " TL_CourseList.[Delv Mthd Tot Hrs], TL_SourceTraining.TrainSource, TL_CourseList.StandardRequiredDt," & _
                " TL_CourseFreq.[Frequency Required]" & _
            " ORDER BY TL_CourseList.StandardRequiredDt, TL_CourseList.[Ilp Learning Cd]"

   Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
   If rs.RecordCount = 0 Then
      MsgBox "There Are No Records to Export for the Courses Selected.", vbInformation, "No Data To Export..."
      GoTo ExitProc
   Else
      rs.MoveLast: rs.MoveFirst 'Required to get an accurate count of records.
      intRecordCount = rs.RecordCount
   End If
   
   If Dir(strFileName) <> "" Then
      Kill (strFileName)
   End If
    'Sets name of Excel worksheet within the Workbook based on above mentioned Template -
    'to be updated based on Unit Chief Name selected form listbox
    strSQL1 = "SELECT BEMS AS UCBEMS, WkshtName FROM qryUnitChief WHERE BEMS In (" & MyString & ")"
    If rs.RecordCount = 0 Then
        Call _
            MsgBox("Please make a selection from the list, Click Update and then Click Export to Excel upon completion of the processing of the Update Data.", _
            vbCritical, "No Data Found")
    Else
        Set rs1 = CurrentDb.OpenRecordset(strSQL1, dbOpenSnapshot)
        Set xlApp = CreateObject("Excel.Application")
            Do Until rs1.EOF
                gWkSht = rs1.Fields("WkshtName").value
                gBEMS = rs1.Fields("UCBEMS").value
                With xlApp
                 If bolSwitch = False Then
                    bolSwitch = True
                    .Workbooks.Add CurrentProject.path & "\2010 FTI-ME Ent-DP.xlt"
                 End If
                 .Worksheets(gWkSht).Activate
                 'Copy course name and course number data, starting at cell F11 = Row 11, Column 6
                    i = 7
                    rs.MoveFirst
                       Do Until rs.EOF
                          .ActiveSheet.Cells(6, 3).value = Date   'Date Report Ran
                          .ActiveSheet.Cells(6, i).value = rs!StandardRequiredDt 'Course Required by Date
                          .ActiveSheet.Cells(7, i).value = rs!Duration 'Course duration
                          .ActiveSheet.Cells(8, i).value = rs!CourseSource 'Source of Course
                          .ActiveSheet.Cells(9, i).value = Trim(rs!CourseTitle) 'Course Title
                          .ActiveSheet.Cells(10, i).value = rs!CourseNumber 'Course ID
                          i = i + 1
                          rs.MoveNext
                       Loop
                    'Copy detail data, starting at cell "A11"(eleven)
                    strSQL2 = "SELECT * FROM zTempData Where UCBEMS IN(" & gBEMS & ") ORDER BY EmployeeName"
                    Set rs2 = CurrentDb.OpenRecordset(strSQL2, dbOpenSnapshot)
                       .Range("A11").CopyFromRecordset rs2
                       .Visible = True
                        blnSuccess = True
'<<<<<<<<<<<<<<<<<<<<<<<<<
                    FormatWS xlWs
                       If gWkSht = "Enterprise_ACS" Then
                            Formatting_ACS '(gWkSht)
                       ElseIf gWkSht = "Enterprise_INFSTR" Then
                           Formatting_INFSTR '(gWkSht)
                       End If
                End With
                rs1.MoveNext
           Loop
'<<<<<<<<<<<<<<<<<<<<<<<<<
              xlApp.Workbook.SaveAs strFileName
            If blnSuccess = True Then
               StatusMsg Me, Mid(strFileName, Len(strFolder) + 1) & " report has been saved to your Desktop folder.", vbBlue
            End If
        End If
ExitProc:
'Cleanup
   If Not rs Is Nothing Then
      rs.Close: Set rs = Nothing
   End If
   If Not rs1 Is Nothing Then
      rs1.Close: Set rs1 = Nothing
   End If
   If Not rs2 Is Nothing Then
      rs2.Close: Set rs2 = Nothing
   End If
   'Set CurrentDb = Nothing
   Exit Sub
ProcError:
    Select Case Err.Number
        Case 70
            MsgBox "You Must Close the FTI-ME Ent-DP.xls File" & vbCrLf _
            & "Before Attempting to Run This Function.", vbCritical, "Cannot Delete Open File..."
        Case 438
            GoTo ExitProc
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, _
              vbCritical, "Error in procedure cmdExportToExcel_Click..."
    End Select
   Resume ExitProc
   Resume
End Sub

Sub FormatWS(ws As Excel.Worksheet)
Dim rng As Range
Dim cl As Range
Dim LastRow As Long

    With ws
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("G11:AJ" & LastRow)
    End With

    For Each cl In rng

        'if current cell is empty or equal to "NR"
        If cl.value = "" Or cl.value = "NR" Then
            cl.Interior.ColorIndex = xlColorIndexNone
            'If course Due Date(F7) > current Date(B5) and current value is Null
            If ws.Cells(7, cl.Column) > ws.Cells(7, 2) And cl.value <> "NR" Then
                cl.Interior.Color = vbRed
            End If
        Else
            cl.Font.ColorIndex = xlColorIndexAutomatic
            cl.Interior.ColorIndex = xlColorIndexNone
        End If

        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) > ws.Cells(7, 2) Then
            cl.Interior.Color = vbYellow
        End If

        If cl.value > ws.Cells(7, 2) And cl.value <> "NR" Then
            cl.Font.Color = vbRed
        End If

        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) < ws.Cells(7, 2) Then
            cl.Interior.Color = vbRed
        End If

        'if Course Date(current cell value) > Course Due Date(F7) and < Year End date
        If cl.value >= ws.Cells(7, cl.Column) And cl.value <= DateSerial(Year(ws.Cells(7, 2)), 13, 0) Then
            cl.Interior.Color = vbCyan
        End If

        'if the last four characters of Employee name (C11) contains "****" ie.  John Smith**** then they should be considered New Employee
        If Right(ws.Cells(cl.Row, "C"), 4) = "****" And cl.value = "" Then
            cl.value = "NH"
            cl.Font.Color = vbBlack
            cl.Interior.Color = vbGreen
        End If

        If ws.Cells(9, cl.Column) = "" Then
            cl.Interior.ColorIndex = xlColorIndexNone
        End If

    Next cl

End Sub
Sub Formatting_INFSTR()
Dim ws As Worksheet
Dim rng As Range
Dim cl As Range
Dim LastRow As Long
Dim xlApp As Excel.Application
   ' frm.Form.txtStatusMsg.Caption = "Processing formatting for spreadsheet"
    Set ws = Worksheets("Enterprise_INFSTR")
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set rng = ws.Range("G11:AJ" & LastRow)
    For Each cl In rng
        'if current cell is empty or equal to "NR"
        If cl.value = "" Or cl.value = "NR" Then
            cl.Interior.ColorIndex = xlColorIndexNone
            'If course Due Date(F7) > current Date(B5) and current value is Null
            If ws.Cells(7, cl.Column) > ws.Cells(7, 2) And cl.value <> "NR" Then
                cl.Interior.Color = vbRed
            End If
        Else
            cl.Font.ColorIndex = xlColorIndexAutomatic
            cl.Interior.ColorIndex = xlColorIndexNone
        End If
        
        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) > ws.Cells(7, 2) Then
            cl.Interior.Color = vbYellow
        End If
        
        If cl.value > ws.Cells(7, 2) And cl.value <> "NR" Then
            cl.Font.Color = vbRed
        End If
        
        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) < ws.Cells(7, 2) Then
            cl.Interior.Color = vbRed
        End If
        
        'if Course Date(current cell value) > Course Due Date(F7) and < Year End date
        If cl.value >= ws.Cells(7, cl.Column) And cl.value <= DateSerial(Year(ws.Cells(7, 2)), 13, 0) Then
            cl.Interior.Color = vbCyan
        End If
        'if the last four characters of Employee name (C11) contains "****" ie.  John Smith**** then they should be considered New Employee
        If Right(ws.Cells(cl.Row, "C"), 4) = "****" And cl.value = "" Then
            cl.value = "NH"
            cl.Font.Color = vbBlack
            cl.Interior.Color = vbGreen
        End If
        If ws.Cells(9, cl.Column) = "" Then
            cl.Interior.ColorIndex = xlColorIndexNone
        End If
    Next cl

End Sub
Sub Formatting_ACS()
Dim ws As Worksheet
Dim rng As Range
Dim cl As Range
Dim LastRow As Long
Dim xlApp As Excel.Application

    Set ws = Worksheets("Enterprise_ACS")
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set rng = ws.Range("G11:AJ" & LastRow)
    For Each cl In rng
        'if current cell is empty or equal to "NR"
        If cl.value = "" Or cl.value = "NR" Then
            cl.Interior.ColorIndex = xlColorIndexNone
            'If course Due Date(F7) > current Date(B5) and current value is Null
            If ws.Cells(7, cl.Column) > ws.Cells(7, 2) And cl.value <> "NR" Then
                cl.Interior.Color = vbRed
            End If
        Else
            cl.Font.ColorIndex = xlColorIndexAutomatic
            cl.Interior.ColorIndex = xlColorIndexNone
        End If
        
        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) > ws.Cells(7, 2) Then
            cl.Interior.Color = vbYellow
        End If
        
        If cl.value > ws.Cells(7, 2) And cl.value <> "NR" Then
            cl.Font.Color = vbRed
        End If
        
        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) < ws.Cells(7, 2) Then
            cl.Interior.Color = vbRed
        End If
        
        'if Course Date(current cell value) > Course Due Date(F7) and < Year End date
        If cl.value >= ws.Cells(7, cl.Column) And cl.value <= DateSerial(Year(ws.Cells(7, 2)), 13, 0) Then
            cl.Interior.Color = vbCyan
        End If
        'if the last four characters of Employee name (C11) contains "****" ie.  John Smith**** then they should be considered New Employee
        If Right(ws.Cells(cl.Row, "C"), 4) = "****" And cl.value = "" Then
            cl.value = "NH"
            cl.Font.Color = vbBlack
            cl.Interior.Color = vbGreen
        End If
        If ws.Cells(9, cl.Column) = "" Then
            cl.Interior.ColorIndex = xlColorIndexNone
        End If
    Next cl

End Sub
 
Last edited:
Guus2005

Guus2005

AWF VIP
Local time
Today, 16:11
Joined
Jun 26, 2007
Messages
2,641
Your question is incomprehensive and might not get a lot of response.

When I attempt to create an If statement to look at the name of the wksht, the function activates corrrectly, however, it does not like the Set wksht = Worksheet("Enterprise ACS") portion of my function ...
Click to expand...
I don't like that either because i can't find it.

Perhaps that's what's wrong??
 
gemma-the-husky

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 15:11
Joined
Sep 12, 2006
Messages
15,657
it is hard to understand what you are doing

can you not just activate the worksheet you want, rather than declare it as you are doing.

sort of worksheets("somesheet").activate

I am not in a position to check the exact syntax.
 
K

kfschaefer

Registered User.
Local time
Today, 07:11
Joined
Oct 10, 2008
Messages
58
Sorry it is so confusing. Let me simplify. Note for debugging purposes I commented out the error handling.

1. Update and create a Excel Workbook (4 worksheets) from Access Database(vba) based on an Excel Template
2. Populate the specified Worksheet with Recordset data from Access into the proper cells - including headers based on a separate Recordset.
3. Format the indicated Excel worksheet (name via variable) with the conditional formatting found in the Function FormatWS
4, Repeat code for the remaining Worksheets - populated the appropriate data for the wksheet and then format that sheets' cells.

My current code wants to create multiple workbooks instead of creating 1 workbook and update the worksheets within that workbook.

I know it has something to do with the BolSWitch code, but not sure how to prevent the multiple workbooks.

Any sugesstions, here is my latest code see the bolded area within the code for possible problem area.

Code: 
Private Sub cmdExportToExcel_Click()
'On Error GoTo ProcError

'For Late Binding
'   Dim xlApp As Object
  
'For Early Binding
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim rs As DAO.Recordset
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim strDataArray() As String
    Dim strSQL As String
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim strFolder As String
    Dim strFileName As String
    Dim i As Integer, j As Integer, intRecordCount As Integer
    Dim blnSuccess As Boolean
    Dim gWkSht As String
    Dim nRow As Integer
    Dim bolSwitch As Boolean
    
  '  StatusMsg Me, ""
    
    strFolder = GetUsersDesktopFolder
    strFileName = strFolder & "2010 FTI-ME Ent-DP.xls"
   'Determines the column headings for the Training Matrix spreadsheet(s)
    strSQL = "SELECT Mid([Ilp Learning Title],1,InStrRev([Ilp Learning Title],'(')-1) AS CourseTitle," & _
                " TL_CourseList.[Ilp Learning Cd] AS CourseNumber, TL_CourseList.[Delv Mthd Tot Hrs] AS Duration," & _
                " TL_SourceTraining.TrainSource AS CourseSource, TL_CourseList.StandardRequiredDt," & _
                " TL_CourseFreq.[Frequency Required]" & _
            " FROM TL_SourceTraining INNER JOIN (TL_CourseList LEFT JOIN TL_CourseFreq ON" & _
                " TL_CourseList.Frequency = TL_CourseFreq.FreqRecID) ON TL_SourceTraining.SourceRecID = TL_CourseList.SourceRecID" & _
            " WHERE (((TL_CourseList.OnXLS) <> 0) And ((TL_CourseList.InActive) = 0))" & _
            " GROUP BY Mid([Ilp Learning Title],1,InStrRev([Ilp Learning Title],'(')-1), TL_CourseList.[Ilp Learning Cd]," & _
                " TL_CourseList.[Delv Mthd Tot Hrs], TL_SourceTraining.TrainSource, TL_CourseList.StandardRequiredDt," & _
                " TL_CourseFreq.[Frequency Required]" & _
            " ORDER BY TL_CourseList.StandardRequiredDt, TL_CourseList.[Ilp Learning Cd]"

   Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
   If rs.RecordCount = 0 Then
      MsgBox "There Are No Records to Export for the Courses Selected.", vbInformation, "No Data To Export..."
      GoTo ExitProc
   Else
      rs.MoveLast: rs.MoveFirst 'Required to get an accurate count of records.
      intRecordCount = rs.RecordCount
   End If
   
   If Dir(strFileName) <> "" Then
      Kill (strFileName)
   End If
    'Sets name of Excel worksheet within the Workbook based on above mentioned Template -
    'to be updated based on Unit Chief Name selected form listbox
    strSQL1 = "SELECT BEMS AS UCBEMS, WkshtName FROM qryUnitChief WHERE BEMS In (" & MyString & ")"
    If rs.RecordCount = 0 Then
        Call _
            MsgBox("Please make a selection from the list, Click Update and then Click Export to Excel upon completion of the processing of the Update Data.", _
            vbCritical, "No Data Found")
    Else
        Set rs1 = CurrentDb.OpenRecordset(strSQL1, dbOpenSnapshot)
        Set xlApp = CreateObject("Excel.Application")
    Do Until rs1.EOF
        gWkSht = rs1.Fields("WkshtName").value
        gBEMS = rs1.Fields("UCBEMS").value
        With xlApp
[COLOR=SeaGreen][B]      If bolSwitch = False Then
                bolSwitch = True
                .Workbooks.Add CurrentProject.path & "\2010 FTI-ME Ent-DP.xlt"
                Set xlWb = xlApp.Workbooks.Add(CurrentProject.path & "\2010 FTI-ME Ent-DP.xlt")
                Set xlWs = xlWb.Worksheets(gWkSht)
            Else
                Set xlWb = xlApp.Workbooks.Open(CurrentProject.path & "\2010 FTI-ME Ent-DP.xls")
                Set xlWs = xlWb.Worksheets(gWkSht)
            End If[/B][/COLOR]
          ' .Worksheets(gWkSht).Activate
            'Copy course name and course number data, starting at cell F11 = Row 11, Column 6
          '  Debug.Print xlWs
            i = 7
            rs.MoveFirst
                Do Until rs.EOF
                    .ActiveSheet.Cells(6, 3).value = Date   'Date Report Ran
                    .ActiveSheet.Cells(6, i).value = rs!StandardRequiredDt 'Course Required by Date
                    .ActiveSheet.Cells(7, i).value = rs!Duration 'Course duration
                    .ActiveSheet.Cells(8, i).value = rs!CourseSource 'Source of Course
                    .ActiveSheet.Cells(9, i).value = Trim(rs!CourseTitle) 'Course Title
                    .ActiveSheet.Cells(10, i).value = rs!CourseNumber 'Course ID
                    i = i + 1
                    rs.MoveNext
                Loop
            'Copy detail data, starting at cell "A11"(eleven)
            strSQL2 = "SELECT * FROM zTempData Where UCBEMS IN(" & gBEMS & ") ORDER BY EmployeeName"
            Set rs2 = CurrentDb.OpenRecordset(strSQL2, dbOpenSnapshot)
                    .Range("A11").CopyFromRecordset rs2
                    .Visible = True
             blnSuccess = True
[COLOR=SeaGreen][B]           FormatWS xlWs
[/B][/COLOR]      End With
        rs1.MoveNext
    Loop
            xlWb.SaveAs strFileName
            'xlApp.Workbook.SaveAs strFileName
            If blnSuccess = True Then
               StatusMsg Me, Mid(strFileName, Len(strFolder) + 1) & " report has been saved to your Desktop folder.", vbBlue
            End If
        End If
ExitProc:
'Cleanup
   If Not rs Is Nothing Then
      rs.Close: Set rs = Nothing
   End If
   If Not rs1 Is Nothing Then
      rs1.Close: Set rs1 = Nothing
   End If
   If Not rs2 Is Nothing Then
      rs2.Close: Set rs2 = Nothing
   End If
   'Set CurrentDb = Nothing
   Exit Sub
ProcError:
    Select Case Err.Number
        Case 70
            MsgBox "You Must Close the FTI-ME Ent-DP.xls File" & vbCrLf _
            & "Before Attempting to Run This Function.", vbCritical, "Cannot Delete Open File..."
        Case 438
            GoTo ExitProc
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, _
              vbCritical, "Error in procedure cmdExportToExcel_Click..."
    End Select
   Resume ExitProc
   Resume
End Sub

Sub FormatWS(ws As Excel.Worksheet)
Dim rng As Range
Dim cl As Range
Dim LastRow As Long

    With ws
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("G11:AJ" & LastRow)
    End With

    For Each cl In rng

        'if current cell is empty or equal to "NR"
        If cl.value = "" Or cl.value = "NR" Then
            cl.Interior.ColorIndex = xlColorIndexNone
            'If course Due Date(F7) > current Date(B5) and current value is Null
            If ws.Cells(7, cl.Column) > ws.Cells(7, 2) And cl.value <> "NR" Then
                cl.Interior.Color = vbRed
            End If
        Else
            cl.Font.ColorIndex = xlColorIndexAutomatic
            cl.Interior.ColorIndex = xlColorIndexNone
        End If

        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) > ws.Cells(7, 2) Then
            cl.Interior.Color = vbYellow
        End If

        If cl.value > ws.Cells(7, 2) And cl.value <> "NR" Then
            cl.Font.Color = vbRed
        End If

        If cl.value = "" And cl.value <> "NR" And ws.Cells(7, cl.Column) < ws.Cells(7, 2) Then
            cl.Interior.Color = vbRed
        End If

        'if Course Date(current cell value) > Course Due Date(F7) and < Year End date
        If cl.value >= ws.Cells(7, cl.Column) And cl.value <= DateSerial(Year(ws.Cells(7, 2)), 13, 0) Then
            cl.Interior.Color = vbCyan
        End If

        'if the last four characters of Employee name (C11) contains "****" ie.  John Smith**** then they should be considered New Employee
        If Right(ws.Cells(cl.Row, "C"), 4) = "****" And cl.value = "" Then
            cl.value = "NH"
            cl.Font.Color = vbBlack
            cl.Interior.Color = vbGreen
        End If

        If ws.Cells(9, cl.Column) = "" Then
            cl.Interior.ColorIndex = xlColorIndexNone
        End If

    Next cl

End Sub
 
K

kfschaefer

Registered User.
Local time
Today, 07:11
Joined
Oct 10, 2008
Messages
58
Thanks for the input, however, I found the solution - by removing the BolSwitch code and activating the Wrkbook/Worksheets directly corrected the problem.

k
 
You must log in or register to reply here.

Similar threads

R
Updating Excel spreadsheet from within the Access
Replies
8
Views
354
CJ_London
C
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
527
BlueFllame
B
C
Using Access VBA to Loop through Excel Rows
Replies
1
Views
2,311
arnelgp
arnelgp
P
Updating a table with data from an unbound form via VBA In Access 2003 / 2007
Replies
6
Views
833
Pauline123
P
V
Variable Loop (Access to Excel VBA)
Replies
2
Views
1,815
Rx_
Rx_

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom