Referencing information on a hidden sheet?

B

Barteh

Board Regular
Joined
Mar 14, 2003
Messages
93
I have a number of functions that reference sheets which are only used for lookup, a typical example of this code is;

Code: 
Public Function HaeLaitteet(BoxAr, prdFam)
Application.ScreenUpdating = False
On Error Resume Next
srcSheet = ActiveSheet.Name

'Sheets("My_Sheet_Name").Select

For j = 2 To Sheets.Count
    Sheets(j).Select
    If UCase(Left(ActiveSheet.Name, 2)) = "AC" Then
        pituus = Len(prdFam)
        For i = 9 To ActiveSheet.UsedRange.Rows.Count
            If Left(Cells(i, 1), pituus) = prdFam Then
                ReDim Preserve BoxAr(UBound(BoxAr) + 1)
                BoxAr(UBound(BoxAr) - 1) = Cells(i, 1).Value
            End If
        Next i
    End If
Next j

Sheets(srcSheet).Select
HaeLaitteet = BoxAr

End Function

However I dont want "My_Sheet_Name" to be visible within my workbook and would really like to hide it.
Is there away without flashing the pages between visible and invisible to allow this to happen? I've tried hiding the sheets and they do not get used in my look ups :(
 
Last edited by a moderator:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
You can refer to the sheet without selecting the sheet. You should only refer to the sheet in each instruction.
Try the following:

Code: 
Public Function HaeLaitteet(BoxAr, prdFam)
  Dim srcSheet As String, j As Long, pituus As Long, i As Long
  For j = 2 To Sheets.Count
    If UCase(Left([COLOR=#0000ff]Sheets(j).[/COLOR]Name, 2)) = "AC" Then
      pituus = Len(prdFam)
      For i = 9 To [COLOR=#0000ff]Sheets(j).[/COLOR]Range("A" & Rows.Count).End(xlUp).Row
        If Left([COLOR=#0000ff]Sheets(j).[/COLOR]Cells(i, 1), pituus) = prdFam Then
          ReDim Preserve BoxAr(UBound(BoxAr) + 1)
          BoxAr(UBound(BoxAr) - 1) = [COLOR=#0000ff]Sheets(j).[/COLOR]Cells(i, 1).Value
        End If
      Next i
    End If
  Next j
  HaeLaitteet = BoxAr
End Function
 
Upvote 0
Hi Dante,
Thanks for you input, but sadly I am struggling to follow this (im not confidant with Excel and its a sheet I've inherited).

If my sheet is called "My_Sheet_Name", am I to substitute this into your suggested code anywhere?

For reference my entire page looks like the below

Code: 
Public Sub Paivita()
Application.ScreenUpdating = False
On Error Resume Next

Dim BoxArray As Variant
ReDim BoxArray(0)
Worksheets("ABB VSD Protection Guide").UnitBox.List = BoxArray

'BoxArray = HaeLaitteet(BoxArray)
BoxArray = haeTuotePerheet(BoxArray)
Worksheets("ABB VSD Protection Guide").DriveBox.List = BoxArray

Dim OptionArray As Variant
ReDim OptionArray(0)

'OptionArray = HaeOptiot(OptionArray)
Worksheets("ABB VSD Protection Guide").OptionBox.List = OptionArray

Worksheets("ABB VSD Protection Guide").OptionBox.Value = ""
Worksheets("ABB VSD Protection Guide").DriveBox.Value = ""
Worksheets("ABB VSD Protection Guide").UnitBox.Value = ""

Rows(10).ClearContents

Sheets("ABB VSD Protection Guide").Select
Cells(10, 1).Select
End Sub
Private Function haeTuotePerheet(BoxAr)
Application.ScreenUpdating = False
On Error Resume Next

For k = 2 To Sheets.Count
    Sheets(k).Select
    If UCase(Left(ActiveSheet.Name, 2)) = "AC" Then
        For i = 9 To ActiveSheet.UsedRange.Rows.Count
            If Left(Cells(i, 1).Value, 2) = "AC" Then
                code = Cells(i, 1).Value
                lCount = 0
                prdFam = ""
                For j = 1 To Len(code)
                    If Mid(code, j, 1) = "-" Then lCount = lCount + 1
                    If lCount = 1 And (Mid(code, 1, 6) = "ACS580" Or Mid(code, 1, 6) = "ACQ580" Or Mid(code, 1, 6) = "ACH580") Then
                        prdFam = Left(code, j - 1)
                        Exit For
                    End If
                    If lCount = 2 Then
                        prdFam = Left(code, j - 1)
                        Exit For
                    End If
                Next j
                incl = True
                For j = 0 To UBound(BoxAr) - 1
                    If BoxAr(j) = prdFam Then incl = False
                Next j
                If incl And prdFam <> "" Then
                    ReDim Preserve BoxAr(UBound(BoxAr) + 1)
                    BoxAr(UBound(BoxAr) - 1) = prdFam
                End If
            End If
        Next i
    End If
Next k
haeTuotePerheet = BoxAr

End Function
Public Function HaeLaitteet(BoxAr, prdFam)
Application.ScreenUpdating = False
On Error Resume Next
srcSheet = ActiveSheet.Name

'Sheets("ACS850_ACSM1_ACQ810").Select

For j = 2 To Sheets.Count
    Sheets(j).Select
    If UCase(Left(ActiveSheet.Name, 2)) = "AC" Then
        pituus = Len(prdFam)
        For i = 9 To ActiveSheet.UsedRange.Rows.Count
            If Left(Cells(i, 1), pituus) = prdFam Then
                ReDim Preserve BoxAr(UBound(BoxAr) + 1)
                BoxAr(UBound(BoxAr) - 1) = Cells(i, 1).Value
            End If
        Next i
    End If
Next j

Sheets(srcSheet).Select
HaeLaitteet = BoxAr

End Function
Public Function UpdateOptions(ar, prdFam)
    srcSheet = ActiveSheet.Name
    trgSht = ""

    For i = 2 To Sheets.Count
        Sheets(i).Select
        If UCase(Left(ActiveSheet.Name, 2)) = "AC" Then
            pituus = Len(prdFam)
            For j = 9 To ActiveSheet.UsedRange.Rows.Count
                If Left(Cells(j, 1), pituus) = prdFam Then
                    trgSht = i
                    Exit For
                End If
            Next j
            If trgSht <> "" Then Exit For
        End If
    Next i

    If trgSht <> "" Then ar = HaeOptiot(ar, trgSht)
    
    Sheets(srcSheet).Select
    UpdateOptions = ar
    
End Function
Private Function HaeOptiot(OptAr, trgSht)
Application.ScreenUpdating = False
On Error Resume Next

Sheets(trgSht).Select
TargetCol = 6
TargetRow = 4

For i = TargetCol To ActiveSheet.UsedRange.Columns.Count
    If Cells(1, i).Value <> "" Then
        Category = Cells(1, i).Value
        ReDim Preserve OptAr(UBound(OptAr, 1) + 1)
        OptAr(UBound(OptAr, 1) - 1) = Category
    End If
Next i

HaeOptiot = OptAr
    
End Function
Public Sub CollectOptions()
Application.ScreenUpdating = False
On Error Resume Next

Found = 0

If Worksheets("ABB VSD Protection Guide").UnitBox.Value <> "" And Worksheets("ABB VSD Protection Guide").OptionBox.Value <> "" Then
    drive = Worksheets("ABB VSD Protection Guide").UnitBox.Value
    Optio = Worksheets("ABB VSD Protection Guide").OptionBox.Value
    If Worksheets("ABB VSD Protection Guide").OptionButton1.Value = -1 Then
        Voltage = 230
    Else
        Voltage = 115
    End If

    For i = 2 To Sheets.Count
        Sheets(i).Select
        Columns(1).Select
        On Error GoTo findError
        Selection.Find(What:=drive, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Activate
        On Error Resume Next
        DriveRow = ActiveCell.Row
        trgSheet = ActiveSheet.Name
        Exit For
findResume:
    Next i
    
    Rows(1).Select
    Selection.Find(What:=Optio, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
    OptionCol = ActiveCell.Column
    
    For i = OptionCol To 255
        Part = ""
        Volt = ""
        Qty = ""
        
        Sheets(trgSheet).Select
        
        If Cells(1, i).Value <> Optio And Cells(1, i).Value <> "" Then GoTo TheEnd
        
        If Cells(DriveRow, i).Value <> "" Then
            If Cells(6, i).Value Like "*" & Voltage & "*" Then
                PartCat = Cells(4, i).Value
                Part = Cells(5, i).Value
                Volt = Cells(6, i).Value
                Qty = Cells(DriveRow, i).Value
                TechnicalData = Cells(8, i).Value
                PartNumber = Cells(7, i).Value
            Else
                GoTo hyppy
            End If
            
            Sheets("ABB VSD Protection Guide").Select
            
            aa = 10
kierto:
            If Cells(aa, 1).Value = "" Then
                Cells(aa, 1).Value = drive
                Cells(aa, 2).Value = Volt
                Cells(aa, 2).HorizontalAlignment = xlCenter
                Cells(aa, 3).Value = Optio
                Cells(aa, 4).Value = PartCat
                Cells(aa, 5).Value = Part
                Cells(aa, 6).Value = Qty
                Cells(aa, 6).HorizontalAlignment = xlCenter
                Cells(aa, 8).Value = TechnicalData
                Cells(aa, 7).Value = PartNumber
                Range(Cells(aa, 1), Cells(aa, 10)).WrapText = True
            Else
                aa = aa + 1
                GoTo kierto
            End If
                
            Sheets(trgSheet).Select
        End If
hyppy:
    Next i
End If

GoTo TheEnd
    
findError:
    Resume findResume
    
TheEnd:
Sheets("ABB VSD Protection Guide").Select
End Sub
Public Sub ClearArea()

    Range(Cells(10, 1), Cells(1000, 10)).Clear
    Call Paivita

End Sub
 
Last edited by a moderator:
Upvote 0
I tried to adjust all the references to the sheets, so that this works with the hidden sheets.
I have no data to perform the tests, so you must test each of the codes.


Code: 
Public Sub Paivita()
  Application.ScreenUpdating = False
  On Error Resume Next
  Dim BoxArray As Variant
  ReDim BoxArray(0)
  Worksheets("ABB VSD Protection Guide").UnitBox.List = BoxArray
  'BoxArray = HaeLaitteet(BoxArray)
  BoxArray = haeTuotePerheet(BoxArray)
  Worksheets("ABB VSD Protection Guide").DriveBox.List = BoxArray
  Dim OptionArray As Variant
  ReDim OptionArray(0)
  'OptionArray = HaeOptiot(OptionArray)
  Worksheets("ABB VSD Protection Guide").OptionBox.List = OptionArray
  Worksheets("ABB VSD Protection Guide").OptionBox.Value = ""
  Worksheets("ABB VSD Protection Guide").DriveBox.Value = ""
  Worksheets("ABB VSD Protection Guide").UnitBox.Value = ""
  Worksheets("ABB VSD Protection Guide").Rows(10).ClearContents
  'Sheets("ABB VSD Protection Guide").Select
  'Cells(10, 1).Select
End Sub
  
Private Function haeTuotePerheet(BoxAr)
  Application.ScreenUpdating = False
  On Error Resume Next
  For k = 2 To Sheets.Count
    'Sheets(k).Select
    If UCase(Left(Sheets(k).Name, 2)) = "AC" Then
      For i = 9 To Sheets(k).Range("A" & Rows.Count).End(xlUp).Row '.UsedRange.Rows.Count
        If Left(Sheets(k).Cells(i, 1).Value, 2) = "AC" Then
          code = Sheets(k).Cells(i, 1).Value
          lCount = 0
          prdFam = ""
          For j = 1 To Len(code)
            If Mid(code, j, 1) = "-" Then lCount = lCount + 1
            If lCount = 1 And (Mid(code, 1, 6) = "ACS580" Or Mid(code, 1, 6) = "ACQ580" Or Mid(code, 1, 6) = "ACH580") Then
              prdFam = Left(code, j - 1)
              Exit For
            End If
            If lCount = 2 Then
              prdFam = Left(code, j - 1)
              Exit For
            End If
          Next j
          incl = True
          For j = 0 To UBound(BoxAr) - 1
            If BoxAr(j) = prdFam Then incl = False
          Next j
          If incl And prdFam <> "" Then
            ReDim Preserve BoxAr(UBound(BoxAr) + 1)
            BoxAr(UBound(BoxAr) - 1) = prdFam
          End If
        End If
      Next i
    End If
  Next k
  haeTuotePerheet = BoxAr
End Function


Public Function HaeLaitteet(BoxAr, prdFam)
  Dim srcSheet As String, j As Long, pituus As Long, i As Long
  For j = 2 To Sheets.Count
    If UCase(Left(Sheets(j).Name, 2)) = "AC" Then
      pituus = Len(prdFam)
      For i = 9 To Sheets(j).Range("A" & Rows.Count).End(xlUp).Row
        If Left(Sheets(j).Cells(i, 1), pituus) = prdFam Then
          ReDim Preserve BoxAr(UBound(BoxAr) + 1)
          BoxAr(UBound(BoxAr) - 1) = Sheets(j).Cells(i, 1).Value
        End If
      Next i
    End If
  Next j
  HaeLaitteet = BoxAr
End Function


Public Function UpdateOptions(ar, prdFam)
  'srcSheet = ActiveSheet.Name
  trgSht = ""
  For i = 2 To Sheets.Count
    'Sheets(i).Select
    If UCase(Left(Sheets(i).Name, 2)) = "AC" Then
      pituus = Len(prdFam)
      For j = 9 To Sheets(i).UsedRange.Rows.Count
        If Left(Sheets(i).Cells(j, 1), pituus) = prdFam Then
          trgSht = i
          Exit For
        End If
      Next j
      If trgSht <> "" Then Exit For
    End If
  Next i
  If trgSht <> "" Then ar = HaeOptiot(ar, trgSht)
  'Sheets(srcSheet).Select
  UpdateOptions = ar
End Function


Private Function HaeOptiot(OptAr, trgSht)
  Application.ScreenUpdating = False
  On Error Resume Next
  'Sheets(trgSht).Select
  TargetCol = 6
  TargetRow = 4
  For i = TargetCol To Sheets(trgSht).Cells(1, Columns.Count).End(xlToLeft).Column
    If Sheets(trgSht).Cells(1, i).Value <> "" Then
      Category = Sheets(trgSht).Cells(1, i).Value
      ReDim Preserve OptAr(UBound(OptAr, 1) + 1)
      OptAr(UBound(OptAr, 1) - 1) = Category
    End If
  Next i
  HaeOptiot = OptAr
End Function


Public Sub CollectOptions()
  Application.ScreenUpdating = False
  On Error Resume Next
  Found = 0
  If Worksheets("ABB VSD Protection Guide").UnitBox.Value <> "" And Worksheets("ABB VSD Protection Guide").OptionBox.Value <> "" Then
    drive = Worksheets("ABB VSD Protection Guide").UnitBox.Value
    Optio = Worksheets("ABB VSD Protection Guide").OptionBox.Value
    If Worksheets("ABB VSD Protection Guide").OptionButton1.Value = -1 Then
      Voltage = 230
    Else
      Voltage = 115
    End If
    Dim f As Range
    For i = 2 To Sheets.Count
      Set f = Sheets(i).Columns(1).Find(drive, , xlValues, xlPart)
      If Not f Is Nothing Then
        DriveRow = f.Row
        trgSheet = Sheets(i).Name
        Exit For
      End If
    Next i
    'Rows(1).Select
    Set f = Sheets(trgSheet).Rows(1).Find(Optio, , xlValues, xlPart)
    If Not f Is Nothing Then
      OptionCol = f.Column
      For i = OptionCol To 255
        Part = ""
        Volt = ""
        Qty = ""
        'Sheets(trgSheet).Select
        If Sheets(trgSheet).Cells(1, i).Value <> Optio And Cells(1, i).Value <> "" Then GoTo TheEnd
        If Sheets(trgSheet).Cells(DriveRow, i).Value <> "" Then
          If Sheets(trgSheet).Cells(6, i).Value Like "*" & Voltage & "*" Then
            PartCat = Sheets(trgSheet).Cells(4, i).Value
            Part = Sheets(trgSheet).Cells(5, i).Value
            Volt = Sheets(trgSheet).Cells(6, i).Value
            Qty = Sheets(trgSheet).Cells(DriveRow, i).Value
            TechnicalData = Sheets(trgSheet).Cells(8, i).Value
            PartNumber = Sheets(trgSheet).Cells(7, i).Value
          Else
            GoTo hyppy
          End If
          'Sheets("ABB VSD Protection Guide").Select
          aa = 10
kierto:
          With Sheets("ABB VSD Protection Guide")
            If .Cells(aa, 1).Value = "" Then
              .Cells(aa, 1).Value = drive
              .Cells(aa, 2).Value = Volt
              .Cells(aa, 2).HorizontalAlignment = xlCenter
              .Cells(aa, 3).Value = Optio
              .Cells(aa, 4).Value = PartCat
              .Cells(aa, 5).Value = Part
              .Cells(aa, 6).Value = Qty
              .Cells(aa, 6).HorizontalAlignment = xlCenter
              .Cells(aa, 8).Value = TechnicalData
              .Cells(aa, 7).Value = PartNumber
              .Range(.Cells(aa, 1), .Cells(aa, 10)).WrapText = True
            Else
              aa = aa + 1
              GoTo kierto
            End If
            'Sheets(trgSheet).Select
        End If
hyppy:
      Next i
    End If
    GoTo TheEnd
findError:
  Resume findResume
TheEnd:
  'Sheets("ABB VSD Protection Guide").Select
End Sub


Public Sub ClearArea()
  Range(Cells(10, 1), Cells(1000, 10)).Clear
  Call Paivita
End Sub


Note: If posting code please use code tags.
i.e.
Code: 
your code
 
Upvote 0
It is a fairly long code.
It takes time to test all the functionality.
Help me to help you.
Test the code part by part and tell me where you are having problems, what error message appears and on which line it stops.
Try to analyze the changes I made so that you also try to adapt your code.
 
Upvote 0
Apologies but im finding this quite difficult to test individually. When using the code in whole the list menus are not displaying any information.
Something else I have spotted, the master page (with lookups/list menus) also has the following code;

Code: 
Private Sub DriveBox_Click()

    Dim BoxArray As Variant
    ReDim BoxArray(0)
    
    BoxArray = HaeLaitteet(BoxArray, DriveBox.Value)
    
    UnitBox.List = BoxArray
    
    Dim OptionArray As Variant
    ReDim OptionArray(0)
    
    OptionArray = UpdateOptions(OptionArray, DriveBox.Value)
    
    OptionBox.List = OptionArray
    
End Sub

Private Sub OptionBox_Change()

    Call CollectOptions

End Sub

Private Sub OptionButton1_Click()

    Call CollectOptions
    
End Sub

Private Sub OptionButton2_Click()

    Call CollectOptions
    
End Sub

Private Sub UnitBox_Click()

    Call CollectOptions

End Sub

And the 'ThisWorkbook' page also has the following;

Code: 
Private Sub Workbook_Open()

    Call Paivita

End Sub

I wasnt sure if there is anything in these that would conflict? apologies for not spotting this sooner.
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question
Running through a Config and pulling out the relevant information using keywords into smaller sheets
Replies
0
Views
133
oitbc
O
C
  • Question
Copy Data (Almost there)
Replies
2
Views
312
craig2525
C
M
  • Question
Help with VBA code when selecting next sheet in workbook
Replies
3
Views
192
StephenCrump
S
D
  • Solved
Move sheet to the end
Replies
1
Views
121
mumps
mumps
P
  • Question
Help With VBA Script
Replies
0
Views
143
Pirate_tat87
P

Forum statistics

Threads
1,214,833
Messages
6,121,868
Members
449,053
Latest member
Mesh

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