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
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
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).
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.
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
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
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(By Val 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(By
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
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.
ASKER
done that and still nothing
Where did you put the code?
ASKER
ThisWorkbook
Any chance you can post the workbook? The code should fire whenever the workbook calculates.
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
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.
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.
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?
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.
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.
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?
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?
Is there a way to pause this from firing whilst the majority of my other code runs?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Great, all working and well many thanks for your help.
Glad to help - thanks for the grade.
Rory
Rory