Link to home
Start Free TrialLog in
Avatar of sq30
sq30

asked on

Export / Import class file

https://www.experts-exchange.com/questions/25823890/VBA-to-colour-cell-background-rather-than-use-conditional-formatting.html

Because this code is held in the worksheet rather than the module and the worksheet doesn't exist until other code that I run creates it how do I get this code in there using VBA. The VBA project will be password protected if that makes a difference?  Thanks
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

I would use the Workbook_SheetChange event rather than the Worksheet_Change event. The workbook level version runs for any sheet in the workbook, so if there are some you don't want affected, you would need to exclude those (by name for example).
Avatar of sq30
sq30

ASKER

Hi, I've tried to do this but I get an error message saying compile error - method or data member not found - it's stopping on  .rows. Also how would I exclude sheets from this? Thanks.
Please post the code you are using.
Avatar of sq30

ASKER


Private Sub Worksheet_Calculate()
     
    Dim LastR As Long
    Dim cel As Range
     
    Application.EnableEvents = False
     
    With Me
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        For Each cel In .Range("g3:g" & LastR).Cells
            Select Case UCase(Left(cel, 5))
                Case "": cel.EntireRow.Interior.ColorIndex = xlColorIndexNone
                Case "AAA01": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 36
                Case "BBB00": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 3
                Case "BBB01": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 3
                Case Else: cel.EntireRow.Interior.ColorIndex = xlColorIndexNone
            End Select
        Next
    End With
    
 With Me
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        For Each cel In .Range("g3:g" & LastR).Cells
            Select Case UCase(Left(cel, 2))
                 Case "BE": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 40
                            
                            End Select
        Next
    End With
    
    With Me
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        For Each cel In .Range("f3:f" & LastR).Cells
            Select Case UCase(Left(cel, 3))
                Case "DD1": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 40
                Case "DD5": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 40
                Case "DD9": Cells(cel.Row, "a").Resize(1, 11).Interior.ColorIndex = 40
                End Select
        Next
    End With
         
    Application.EnableEvents = True
   
     
End Sub

Open in new window

That's not the right event - you need the Workbook_SheetCalculate event, not the worksheet one (you can't simply move the code to the ThisWorkbook module - it's actually a different code):

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
     
    Dim LastR As Long, lngRow As Long
    Dim cel As Range
     
    Application.EnableEvents = False
     
    With Sh
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        For lngRow = 3 To LastR
            Select Case UCase(Left(.Cells(lngRow, "G").Value, 5))
                Case "": cel.EntireRow.Interior.ColorIndex = xlColorIndexNone
                Case "AAA01": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 36
                Case "BBB00": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 3
                Case "BBB01": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 3
                Case Else: .Rows(lngRow).Interior.ColorIndex = xlColorIndexNone
            End Select
            If UCase(Left(.Cells(lngRow, "G").Value, 2)) = "BE" Then .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
            Select Case UCase(Left(.Cells(lngRow, "F").Value, 3))
                Case "DD1": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
                Case "DD5": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
                Case "DD9": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
            End Select
        Next lngRow
    End With
         
    Application.EnableEvents = True
End Sub

Open in new window

Avatar of sq30

ASKER

Yes, I can see from your code it's quite different. The new code does not appear to do anything and how do I exclude worksheets that I don't wnat this to run on? Thanks
It's only really the first line that has to be different:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

the rest of the code I altered as it's very inefficient to have three loops in it, when you are looping through the same rows each time.
This version shows how to skip certain sheets (Sheet1 and Sheet2 in the example):

Note: the code must go in the ThisWorkbook module.
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
     
    Dim LastR As Long, lngRow As Long
    Dim cel As Range
     
    Application.EnableEvents = False
    
    Select Case UCase$(Sh.Name)
    
        Case "SHEET1", "SHEET2"
            ' do nothing for these two sheets
        Case Else
            ' run the code
            With Sh
                LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
                For lngRow = 3 To LastR
                    Select Case UCase(Left(.Cells(lngRow, "G").Value, 5))
                        Case "": cel.EntireRow.Interior.ColorIndex = xlColorIndexNone
                        Case "AAA01": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 36
                        Case "BBB00": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 3
                        Case "BBB01": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 3
                        Case Else: .Rows(lngRow).Interior.ColorIndex = xlColorIndexNone
                    End Select
                    If UCase(Left(.Cells(lngRow, "G").Value, 2)) = "BE" Then .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
                    Select Case UCase(Left(.Cells(lngRow, "F").Value, 3))
                        Case "DD1": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
                        Case "DD5": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
                        Case "DD9": .Cells(lngRow, "a").Resize(1, 11).Interior.ColorIndex = 40
                    End Select
                Next lngRow
            End With
            
    End Select
         
    Application.EnableEvents = True
End Sub

Open in new window

Avatar of sq30

ASKER

Thank you but what event makes this code run? I've tried recalcing the workbook.
I suspect you have disabled events in your testing. Save the file and close and reopen Excel to reset events.
Avatar of sq30

ASKER

done that and still nothing
Where did you put the code?
Avatar of sq30

ASKER

ThisWorkbook
Any chance you can post the workbook? The code should fire whenever the workbook calculates.
Avatar of sq30

ASKER

Sorry I'd love to post the all singing all dancing version that you guys have helped my create but I can't.
test.xls
Your code uses column A to determine the last used row, but you don't have any data beyond row 2 in column A.
Avatar of sq30

ASKER

I can't give you the real data but colum A has data in every row down to row 485
Do you have any formulas in your sheet? If not, the Calculate event won't fire.
Avatar of sq30

ASKER

No, and there is nothing manually typed in this sheet either.
 
I've just type in a sum to check that the code would fire and it does. Why does the calculate sheet not trigger the event even if there is a formula?  
 
The sheet only calculates if it needs to. If your formulas are not affected by any changes you make, then they won't recalculate. If you want each row to be checked as it's changed, you should be using a Change event not a Calculate event.
Avatar of sq30

ASKER

How is that achieved?
First off, can I just check how your sheet is populated with data and how/when you need the cells coloured? In your last question Patrick gave you both Change and Calculate codes so I'd like to check which is actually applicable here.
Avatar of sq30

ASKER

The data is fed in from another worksheet using a scripting dictionary that consolidates different lines of source data which are identical with different monetarty values in to one line with a total of all the affore mentioned lines. This is the first code that runs, I do have some macros that go and change cell values but only the value is put in the cell not a sum/formula. I think change is going to be applicable?  

Avatar of sq30

ASKER

This will run in the full version of my workbook if I comment out lines 18 & 22 of your last code posting. The error I'm getting an run time error code 91 object variable or with block variable not set.
Is there a way to pause this from firing whilst the majority of my other code runs?
ASKER CERTIFIED SOLUTION
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of sq30

ASKER

Great, all working and well many thanks for your help.
Glad to help - thanks for the grade.
Rory