Macro doesn't work with hidden worksheets

V

VBA_Newbie

Active Member
Joined
Jan 7, 2005
Messages
258
Hi folks,

I have a working macro which accesses a sheet called 'data' and does some stuff (I don't think it's necessary to bore you with the details).

However, I don't want the user to see the 'data' worksheet, so I made it a hidden worksheet. After I did that, I tried to execute the same macro and wouldn't work. I can only guess this has something to do with the worksheet being hidden.

My question: Would I need to write code to unhide the worksheet before the macro tries to access it's information? Or is there another way around this?

Many thanks,
Mike
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Depends on what your macro does. Most things can be done without selecting (meaning it must be visible) the other (i.e. data) sheet, but some things (such as calculating the sheet) require it to be visible.

We'll be better suited to answer your question if you post the code you're using...
 
Upvote 0
Without seeing the macro it's hard to say. Please post your macro.
 
Upvote 0
Here it is...as you can see it's quite a long macro. I didn't actually write most of it. It was written by someone else (who it appears really knew what they were doing). I'm just modifying bits and pieces of it.


Code: 
Sub VanWest()
    Dim numrec As Integer
    Dim numprice As Integer
    Dim mtprice As Currency, mt As Single
    Dim mrprice As Currency, mr As Single
    Dim mdp As Currency, mgp As Currency, idp As Currency, ops As Currency, inc As Single
    Dim pmdp As Single, pmgp As Single, pidp As Single, pops As Single
    Dim t1 As Integer, t2 As Integer, t3 As Integer, t4 As Integer
    Dim numb As Integer, col As Integer
    Dim n1 As Single, n2 As Single, n3 As Single, n4 As Single
    
Call ExtractSubset
' Validate probability values

 t3 = 6
    For t1 = 4 To 7
        For t2 = t1 + 1 To 8
            If IsNumeric(Sheets("Setup").Cells(t1, t3).Text) = False Or IsNumeric(Sheets("Setup").Cells(t2, t3).Text) = False Then
                MsgBox "Non-numeric entry in purchase probabilities": GoTo 999
            End If
            If Sheets("Setup").Cells(t1, t3).Value > 1 Or Sheets("Setup").Cells(t1, t3).Value < 0 Or Sheets("Setup").Cells(t2, t3).Value > 1 Or Sheets("Setup").Cells(t2, t3).Value < 0 Then
                MsgBox "Purchase probabilities must be between 0 and 1": GoTo 999
            End If
            If Sheets("Setup").Cells(t1, t3).Value = Sheets("Setup").Cells(t2, t3).Value Then
                MsgBox "Cannot assign more than one purchase probability answer the same probability": GoTo 999
            End If
        Next t2
    Next t1
   
            
' Clear out workspace
    Sheets("Data").Select
    ActiveSheet.Unprotect
    Columns("I:IV").Select
    Selection.ClearContents
    
' Clean data

    numrec = 0
    For t1 = 1 To 8
        t2 = Application.CountA(Range(Cells(1, t1), Cells(4000, t1)))
        If t2 > numrec Then numrec = t2
    Next t1
    
    For t1 = 1 To numrec
        t2 = 0
' blank out non-numeric cells
        For t3 = 1 To 8
            If IsNumeric(Cells(t1, t3)) = False Then Cells(t1, t3) = ""
        Next t3
' if "too expensive" or "too cheap" price is blank then relace with max/min
        If Cells(t1, 1) = "" Then Cells(t1, 1).Value = Application.WorksheetFunction.Max(Range("A:A"))
        If Cells(t1, 4) = "" Then Cells(t1, 4).Value = Application.WorksheetFunction.Min(Range("D:D"))
' if "expensive" or "bargain" price is blank then reject record
        If Cells(t1, 2) = "" Or Cells(t1, 3) = "" Then t2 = 1: GoTo 5
        n1 = Cells(t1, 1).Value: n2 = Cells(t1, 2).Value: n3 = Cells(t1, 3).Value: n4 = Cells(t1, 4).Value
        If n1 = 0 Or n2 = 0 Or n3 = 0 Then t2 = 1
        If n3 < n4 Or n2 < n3 Or n1 < n2 Then t2 = 1
5       If t2 = 1 Then Rows(t1).ClearContents
    Next t1
    Columns("A:H").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    t1 = 0: t2 = 0: n1 = 0: n2 = 0: n3 = 0: n4 = 0: numrec = 0

' Recode probabilities

    Columns("E:H").Replace What:=Sheets("Setup").Range("e4"), Replacement:="A", LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:=Sheets("Setup").Range("e5"), Replacement:="B", LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:=Sheets("Setup").Range("e6"), Replacement:="C", LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:=Sheets("Setup").Range("e7"), Replacement:="D", LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:=Sheets("Setup").Range("e8"), Replacement:="E", LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:="A", Replacement:=Sheets("Setup").Range("f4"), LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:="B", Replacement:=Sheets("Setup").Range("f5"), LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:="C", Replacement:=Sheets("Setup").Range("f6"), LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:="D", Replacement:=Sheets("Setup").Range("f7"), LookAt:=xlWhole, SearchOrder:=xlByRows
    Columns("E:H").Replace What:="E", Replacement:=Sheets("Setup").Range("f8"), LookAt:=xlWhole, SearchOrder:=xlByRows
    Sheets("Setup").Range("f4:f8").Copy
    Sheets("Setup").Range("e4:e8").PasteSpecial
    
' need to calculate the number of records and number of distinct prices
' before defining arrays
    numrec = Application.CountA(Range("A:A"))
    
' Stack and sort all price answers
    t1 = 1
    For t2 = 1 To 4
    For t3 = 1 To numrec
    Cells(t1, 9).Value = Cells(t3, t2)
    t1 = t1 + 1
    Next t3
    Next t2
    Columns("I:I").Sort Key1:=Range("I1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom

' Count the number of distinct price answers given
    numprice = 1
    For t1 = 2 To (numrec * 4)
    If Cells(t1, 9) <> Cells(t1 - 1, 9) Then numprice = numprice + 1
    Next t1
        
' Declare the array variables dependent upon number of records/prices
    ReDim pricebins(1 To numprice) As Currency
    ReDim te(1 To numprice) As Single, ti(1 To numprice) As Single, e(1 To numprice) As Single, i(1 To numprice) As Single
    ReDim itrial(1 To numprice, 1 To numrec) As Single
    For t1 = 1 To numprice
        For t2 = 1 To numrec
            itrial(t1, t2) = 999
        Next t2
    Next t1
        
' Define pricebins
    t1 = 1
    pricebins(t1) = Cells(t1, 9)
    For t2 = 2 To (numrec * 4)
    If Cells(t2, 9) <> Cells(t2 - 1, 9) Then t1 = t1 + 1: pricebins(t1) = Cells(t2, 9)
    Next t2
    
' Calculate proportions

    For t1 = 1 To numprice
    Cells(t1, 10).Value = pricebins(t1)
    n1 = Application.CountIf(Range("a:a"), pricebins(t1))
    If n1 <> 0 Then te(t1) = n1 / numrec
    n1 = Application.CountIf(Range("b:b"), pricebins(t1))
    If n1 <> 0 Then e(t1) = n1 / numrec
    n1 = Application.CountIf(Range("c:c"), pricebins(t1))
    If n1 <> 0 Then i(t1) = n1 / numrec
    n1 = Application.CountIf(Range("d:d"), pricebins(t1))
    If n1 <> 0 Then ti(t1) = n1 / numrec
    Next t1
    
' Cum proportions and set into sheet

    For t1 = 1 To numprice
    Cells(t1, 10).Value = pricebins(t1)
    Cells(t1, 15).Value = pricebins(t1)
    n1 = Application.CountIf(Range("a:a"), pricebins(t1))
    If n1 <> 0 Then Cells(t1, 11).Value = te(t1)
    n1 = Application.CountIf(Range("b:b"), pricebins(t1))
    If n1 <> 0 Then Cells(t1, 12).Value = e(t1)
    n1 = Application.CountIf(Range("c:c"), pricebins(numprice + 1 - t1))
    If n1 <> 0 Then Cells(numprice + 1 - t1, 13).Value = i(numprice + 1 - t1)
    n1 = Application.CountIf(Range("d:d"), pricebins(numprice + 1 - t1))
    If n1 <> 0 Then Cells(numprice + 1 - t1, 14).Value = ti(numprice + 1 - t1)
    If t1 = numprice Then GoTo 10
    te(t1 + 1) = te(t1 + 1) + te(t1)
    e(t1 + 1) = e(t1 + 1) + e(t1)
    i(numprice - t1) = i(numprice + 1 - t1) + i(numprice - t1)
    ti(numprice - t1) = ti(numprice + 1 - t1) + ti(numprice - t1)
    
10  Next t1

' Interpolate proportions

    If Cells(1, 11).Value = "" Then Cells(1, 11).Value = 0
    If Cells(1, 12).Value = "" Then Cells(1, 12).Value = 0
    If Cells(1, 13).Value = "" Then Cells(1, 13).Value = 1
    If Cells(1, 14).Value = "" Then Cells(1, 14).Value = 1
    If Cells(numprice, 11).Value = "" Then Cells(numprice, 11).Value = 1
    If Cells(numprice, 12).Value = "" Then Cells(numprice, 12).Value = 1
    If Cells(numprice, 13).Value = "" Then Cells(numprice, 13).Value = 0
    If Cells(numprice, 14).Value = "" Then Cells(numprice, 14).Value = 0
   
' forwards ...
   
    For col = 11 To 12
    t1 = 1
    n1 = Cells(t1, col).Value
    Do
        t1 = t1 + 1
        If Cells(t1, col).Value = "" Then
            numb = 1
            Do
                t1 = t1 + 1
                If Cells(t1, col).Value <> "" Then n2 = Cells(t1, col).Value Else numb = numb + 1
            Loop Until Cells(t1, col).Value <> ""
            inc = (n2 - n1) / (numb + 1)
            t3 = 1
            For t2 = (t1 - numb) To (t1 - 1)
                Cells(t2, col).Value = n1 + (inc * t3)
                t3 = t3 + 1
            Next t2
            n1 = n2
        Else
            n1 = Cells(t1, col).Value
        End If
    Loop Until t1 = numprice
    Next col
    
' ...and backwards
   
    For col = 13 To 14
    t1 = numprice
    n1 = Cells(t1, col).Value
    Do
        t1 = t1 - 1
        If Cells(t1, col).Value = "" Then
            numb = 1
            Do
                t1 = t1 - 1
                If Cells(t1, col).Value <> "" Then n2 = Cells(t1, col).Value Else numb = numb + 1
            Loop Until Cells(t1, col).Value <> ""
            inc = (n2 - n1) / (numb + 1)
            t3 = 1
            For t2 = (t1 + numb) To (t1 + 1) Step -1
                Cells(t2, col).Value = n1 + (inc * t3)
                t3 = t3 + 1
            Next t2
            n1 = n2
        Else
            n1 = Cells(t1, col).Value
        End If
    Loop Until t1 = 1
    Next col
    
' Set in probabilities
    If Sheets("data").Range("e1") = "" Then GoTo 40
    For t1 = 1 To numrec
        For t2 = 1 To 4
            For t3 = 1 To numprice
                If Cells(t1, t2).Value = pricebins(t3) Then itrial(t3, t1) = Cells(t1, t2 + 4).Value
            Next t3
        Next t2
    Next t1

' Interpolate probabilities

    For col = 1 To numrec
    t1 = 1
    n1 = t1
    Do Until itrial(t1, col) <> 999
        If itrial(t1, col) <> 999 Then n1 = t1 Else t1 = t1 + 1
        If itrial(t1, col) <> 999 Then n1 = t1
    Loop
    Do
        t1 = t1 + 1
        If t1 > numprice Then Exit Do
        If itrial(t1, col) = 999 Then
            Do
                t1 = t1 + 1
                If t1 > numprice Then Exit Do
                If itrial(t1, col) <> 999 Then n2 = t1
            Loop Until itrial(t1, col) <> 999
            If t1 > numprice Then GoTo 30
            inc = (itrial(n2, col) - itrial(n1, col)) / (pricebins(n2) - pricebins(n1))
            For t4 = (n1 + 1) To (n2 - 1)
                itrial(t4, col) = itrial(n1, col) + (inc * (pricebins(t4) - pricebins(n1)))
            Next t4
            n1 = n2
30      End If
    Loop Until t1 = numprice
    Next col

' set placeholders (999's) to zeros, calculate and set in trial/revenue values
    

    For t1 = 1 To numprice
        inc = 0
        For t2 = 1 To numrec
            If itrial(t1, t2) = 999 Then itrial(t1, t2) = 0
            inc = inc + itrial(t1, t2)
        Next t2
        Cells(t1, 16).Value = inc / numrec
        Cells(t1, 17).Value = inc * pricebins(t1) / numrec * n1
    Next t1
        If Application.WorksheetFunction.Max(Range("Q:Q")) <> 0 Then
            n1 = 0.9 / (Application.WorksheetFunction.Max(Range("Q:Q")))
        End If
        
' Calculate IDP,MGP,MDP,OPS,MaxTrial,MaxRevenue


40  idp = -1: mgp = -1: mdp = -1: ops = -1
    pidp = 0: pmgp = 0: pmdp = 0: pops = 0
    mtprice = 0: mt = 0: mrprice = 0: mr = 0
    For t1 = 1 To numprice
        If Cells(t1, 13).Value = Cells(t1, 12) And idp = -1 Then
            idp = pricebins(t1)
            pidp = Cells(t1, 13)
        End If
        If Cells(t1, 13).Value < Cells(t1, 12) And idp = -1 Then
            idp = intercept((pricebins(t1 - 1)), (pricebins(t1)), Cells(t1 - 1, 13), Cells(t1, 13), Cells(t1 - 1, 12), Cells(t1, 12))
            pidp = interceptk((pricebins(t1 - 1)), (pricebins(t1)), (idp), Cells(t1 - 1, 13), Cells(t1, 13))
        End If
        If Cells(t1, 13).Value = Cells(t1, 11).Value And mdp = -1 Then
            mdp = pricebins(t1)
            pmdp = Cells(t1, 13)
        End If
        If Cells(t1, 13).Value < Cells(t1, 11).Value And mdp = -1 Then
            mdp = intercept((pricebins(t1 - 1)), (pricebins(t1)), Cells(t1 - 1, 13), Cells(t1, 13), Cells(t1 - 1, 11), Cells(t1, 11))
            pmdp = interceptk((pricebins(t1 - 1)), (pricebins(t1)), (mdp), Cells(t1 - 1, 13), Cells(t1, 13))
        End If
        If Cells(t1, 14).Value = Cells(t1, 12).Value And mgp = -1 Then
            mgp = pricebins(t1)
            pmgp = Cells(t1, 14)
        End If
        If Cells(t1, 14).Value < Cells(t1, 12).Value And mgp = -1 Then
            mgp = intercept((pricebins(t1 - 1)), (pricebins(t1)), Cells(t1 - 1, 14), Cells(t1, 14), Cells(t1 - 1, 12), Cells(t1, 12))
            pmgp = interceptk((pricebins(t1 - 1)), (pricebins(t1)), (mgp), Cells(t1 - 1, 14), Cells(t1, 14))
        End If
        If Cells(t1, 14).Value = Cells(t1, 11).Value And ops = -1 Then
            ops = pricebins(t1)
            pops = Cells(t1, 14)
        End If
        If Cells(t1, 14).Value < Cells(t1, 11).Value And ops = -1 Then
            ops = intercept((pricebins(t1 - 1)), (pricebins(t1)), Cells(t1 - 1, 14), Cells(t1, 14), Cells(t1 - 1, 11), Cells(t1, 11))
            pops = interceptk((pricebins(t1 - 1)), (pricebins(t1)), (ops), Cells(t1 - 1, 14), Cells(t1, 14))
        End If
        If Sheets("Data").Range("e1") = "" Then GoTo 50
        If Cells(t1, 16) >= mt Then
            mt = Cells(t1, 16)
            mtprice = pricebins(t1)
        End If
        Cells(t1, 17) = Cells(t1, 17) * n1
        If Cells(t1, 17) >= mr Then
            mr = Cells(t1, 17)
            mrprice = pricebins(t1)
        End If
50  Next t1

' Set in labels and points for graphs

    Cells(1, 21) = mgp: Cells(1, 20) = Sheets("Setup").Range("B13") & "=" & Cells(1, 21).Text: Cells(1, 22) = pmgp
    Cells(2, 21) = mgp: Cells(2, 22) = 0.9
    Cells(3, 21) = mdp: Cells(3, 20) = Sheets("Setup").Range("B14") & "=" & Cells(3, 21).Text: Cells(3, 22) = pmdp
    Cells(4, 21) = mdp: Cells(4, 22) = 0.9
    Cells(5, 21) = idp: Cells(5, 20) = Sheets("Setup").Range("B15") & "=" & Cells(5, 21).Text: Cells(5, 22) = pidp
    Cells(6, 21) = ops: Cells(6, 20) = Sheets("Setup").Range("B16") & "=" & Cells(6, 21).Text: Cells(6, 22) = pops
    Cells(7, 21) = mtprice: Cells(7, 20) = Sheets("Setup").Range("B20") & "=" & Cells(7, 21).Text: Cells(7, 22) = mt
    Cells(8, 21) = mrprice: Cells(8, 20) = Sheets("Setup").Range("B21") & "=" & Cells(8, 21).Text: Cells(8, 22) = mr
    Cells(10, 21) = mgp + 0.15: Cells(10, 22) = 0.9
    Cells(11, 21) = mdp - 0.15: Cells(11, 22) = 0.9
    Cells(12, 20) = " (n=" & numrec & ")"

' Update PSM Chart
        
    'Cannot figure out why this line is not working
    Worksheets("SubwayPricing").ChartObjects("Chart 18").Activate
    
   
    ActiveChart.ChartTitle.Select
    Selection.Characters.Text = Sheets("Setup").Range("b4") & chr(10) & Sheets("Setup").Range("b5") & Sheets("Data").Range("t12")
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 14
        .ColorIndex = xlAutomatic
    End With
    ActiveChart.Axes(xlValue).AxisTitle.Select
    Selection.Characters.Text = Sheets("Setup").Range("b7")
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .ColorIndex = xlAutomatic
    End With
    ActiveChart.Axes(xlCategory).AxisTitle.Select
    Selection.Characters.Text = Sheets("Setup").Range("b8")
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .ColorIndex = xlAutomatic
    End With
    ActiveChart.SeriesCollection(3).Name = Sheets("Setup").Range("b9")
    ActiveChart.SeriesCollection(4).Name = Sheets("Setup").Range("b10")
    ActiveChart.SeriesCollection(5).Name = Sheets("Setup").Range("b11")
    ActiveChart.SeriesCollection(6).Name = Sheets("Setup").Range("b12")
    ActiveChart.Axes(xlCategory).Select
    With ActiveChart.Axes(xlCategory)
        .MinimumScale = Int(pricebins(1))
        .MaximumScale = Int(pricebins(numprice) + 0.99)
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .ReversePlotOrder = False
        .ScaleType = xlLinear
    End With
    ActiveChart.SeriesCollection(8).DataLabels.Select
    ActiveChart.SeriesCollection(8).Points(1).DataLabel.Select
    Selection.Characters.Text = Sheets("Setup").Range("B17")
    ActiveChart.SeriesCollection(1).DataLabels.Select
    ActiveChart.SeriesCollection(1).Points(2).DataLabel.Select
    Selection.Characters.Text = Sheets("Data").Range("T1")
    ActiveChart.SeriesCollection(2).DataLabels.Select
    ActiveChart.SeriesCollection(2).Points(2).DataLabel.Select
    Selection.Characters.Text = Sheets("Data").Range("T3")
    ActiveChart.SeriesCollection(7).DataLabels.Select
    ActiveChart.SeriesCollection(7).Points(1).DataLabel.Select
    Selection.Characters.Text = Sheets("Data").Range("T5")
    ActiveChart.SeriesCollection(7).Points(2).DataLabel.Select
    Selection.Characters.Text = Sheets("Data").Range("T6")
    ActiveChart.Deselect
    
' Update Trial Revenue Chart

    Worksheets("SubwayPricing").ChartObjects("Chart 19").Activate
    
    If Sheets("Data").Range("e1") = "" Then
        ActiveChart.SeriesCollection(3).Points(1).DataLabel.Select
        Selection.Characters.Text = "No Data"
        ActiveChart.SeriesCollection(3).Points(2).DataLabel.Select
        Selection.Characters.Text = "No Data"
        ActiveChart.Deselect
        GoTo 998
    End If
    ActiveChart.ChartTitle.Select
    Selection.Characters.Text = Sheets("Setup").Range("b4") & chr(10) & Sheets("Setup").Range("b6") & Sheets("data").Range("t12")
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 14
        .ColorIndex = xlAutomatic
    End With
    ActiveChart.Axes(xlCategory).AxisTitle.Select
    Selection.Characters.Text = Sheets("Setup").Range("b8")
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .ColorIndex = xlAutomatic
    End With
    ActiveChart.SeriesCollection(1).Name = Sheets("Setup").Range("b18")
    ActiveChart.SeriesCollection(2).Name = Sheets("Setup").Range("b19")
    ActiveChart.Axes(xlCategory).Select
    With ActiveChart.Axes(xlCategory)
        .MinimumScale = Int(pricebins(1))
        .MaximumScale = Int(pricebins(numprice) + 0.99)
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .ReversePlotOrder = False
        .ScaleType = xlLinear
    End With
    ActiveChart.SeriesCollection(3).Points(1).DataLabel.Select
    Selection.Characters.Text = Sheets("Data").Range("T7")
    ActiveChart.SeriesCollection(3).Points(2).DataLabel.Select
    Selection.Characters.Text = Sheets("Data").Range("T8")
    ActiveChart.Deselect
    
    
 ' Update Trial/Revenue Price Data Chart
        
   
    Sheets("PE_Interactive").ChartObjects("Chart 1").Activate
    
   
    ActiveChart.ChartTitle.Select
    Selection.Characters.Text = Sheets("Setup").Range("b4") & chr(10) & "Revenue/Trial Price Data" & Sheets("Data").Range("t12")
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 14
        .ColorIndex = xlAutomatic
    End With
    
    
    Sheets("Data").Select
    ActiveSheet.Protect
    
        
998 Worksheets("SubwayPricing").Activate

999 End Sub
    
Function intercept(p0 As Single, p1 As Single, x0 As Single, x1 As Single, y0 As Single, y1 As Single)
intercept = (p0 + ((p1 - p0) * (x0 - y0) / ((y1 - y0) - (x1 - x0))))
End Function

Function interceptk(p0 As Single, p1 As Single, pp As Single, y0 As Single, y1 As Single)
interceptk = (y0 + ((y1 - y0) * ((pp - p0) / (p1 - p0))))
End Function
 
Upvote 0
Taking a quick glance at your code, you'd need to remove things like:

Code: 
' Clear out workspace 
    Sheets("Data").Select 
    ActiveSheet.Unprotect 
    Columns("I:IV").Select 
    Selection.ClearContents

Where you are selecting the Data sheet or anything on it. These lines of code, for example, can be replaced with:

Code: 
' Clear out workspace 
    With Sheets("Data")
    .Unprotect 
    .Columns("I:IV").ClearContents
    End With

Note, however, that if you do not select the Data sheet, code like:

Code: 
' Clean data 

    numrec = 0 
    For t1 = 1 To 8 
        t2 = Application.CountA(Range(Cells(1, t1), Cells(4000, t1))) 
        If t2 > numrec Then numrec = t2 
    Next t1

Will be running against Range(Cells(1, t1), Cells(4000, t1)) on the ACTIVE sheet (which is not Data anymore). So, you will need to revise that code as well to be Sheets("Data").Range(Cells(1, t1), Cells(4000, t1)) etc.

The other option you have, instead of making a whole bunch of changes to your macro, is to unhide the sheet first and (if possible) throw in an application.screenupdating = false so that the user doesn't see the sheet being unhidden and manipulated. This is more of a band-aid fix though, as the .selects will still slow down your code with inefficiencies.
 
Upvote 0
Thanks Oaktree. I'll probably go with the band-aid solution you suggested as I need to get this done quickly (this is my last little project before I start a new job).

Where would I throw in this piece of code?

Code: 
application.screenupdating = false
 
Upvote 0
One other thing...is it possible to throw in message box stating something like "Please wait...charts are being updated"?
 
Upvote 0
Try putting it right before you unhide the sheet. When you run your macro with that line in it, you shouldn't see a bunch of flashing on the screen (try running your code with it and without it...you should see a noticable difference).
 
Upvote 0
Oaktree...you rock. I've solved the hidden worksheets thing...and the "Application.ScreenUpdating = False" is working great too! I'll check out the site you suggested as well! Thanks a million!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Missing Worksheet with Data Validation List Options
Replies
1
Views
160
ajm
A
AOB
  • Question Question
ListObject.ListColumns.Add fails if Excel application is not visible and ScreenUpdating not enabled
Replies
3
Views
67
Domenic
D
A
  • Question Question
Purchase Order macros
Replies
5
Views
328
AndyB86
A
S
  • Solved
Cannot assign macro to button
2
Replies
10
Views
214
SPS41
S
C
  • Question Question
Working with multiple workbooks
Replies
4
Views
89
CT56
C

Forum statistics

Threads
1,224,352
Messages
6,178,068
Members
452,822
Latest member
MtC

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top