Export / Import class file

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_25823890.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
sq30Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rory ArchibaldCommented:
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).
0
sq30Author Commented:
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.
0
Rory ArchibaldCommented:
Please post the code you are using.
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

sq30Author Commented:

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

0
Rory ArchibaldCommented:
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

0
sq30Author Commented:
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
0
Rory ArchibaldCommented:
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

0
sq30Author Commented:
Thank you but what event makes this code run? I've tried recalcing the workbook.
0
Rory ArchibaldCommented:
I suspect you have disabled events in your testing. Save the file and close and reopen Excel to reset events.
0
sq30Author Commented:
done that and still nothing
0
Rory ArchibaldCommented:
Where did you put the code?
0
sq30Author Commented:
ThisWorkbook
0
Rory ArchibaldCommented:
Any chance you can post the workbook? The code should fire whenever the workbook calculates.
0
sq30Author Commented:
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
0
Rory ArchibaldCommented:
Your code uses column A to determine the last used row, but you don't have any data beyond row 2 in column A.
0
sq30Author Commented:
I can't give you the real data but colum A has data in every row down to row 485
0
Rory ArchibaldCommented:
Do you have any formulas in your sheet? If not, the Calculate event won't fire.
0
sq30Author Commented:
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?  
 
0
Rory ArchibaldCommented:
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.
0
sq30Author Commented:
How is that achieved?
0
Rory ArchibaldCommented:
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.
0
sq30Author Commented:
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?  

0
sq30Author Commented:
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?
0
Rory ArchibaldCommented:
Try the version below. If you want to disable the code while running other routines, you need to add:
Application.enableevents = False

to the start of your other routines and then set it back to True at the end.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     
    Dim lngRow As Long
    
    On Error GoTo err_handle
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Select Case UCase$(Sh.Name)
    
        Case "SHEET1", "SHEET2"
            ' do nothing for these two sheets
        Case Else
            ' run the code
            With Sh
                For lngRow = Target.Row To Target.Row + Target.Rows.Count - 1
                    Select Case UCase(Left(.Cells(lngRow, "G").Value, 5))
                        Case "": .Rows(lngRow).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
  
clean_up:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub
    
err_handle:
    MsgBox Err.Description
    Resume clean_up
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
sq30Author Commented:
Great, all working and well many thanks for your help.
0
Rory ArchibaldCommented:
Glad to help - thanks for the grade.
Rory
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.