Activate a sheet in a sub that is defined Within another sub

charchar001

New Member
Joined
Jun 24, 2019
Messages
9
Hey Guys,

I am trying to create a code that does multiple filters and copies data depending on items from a sheet.
There are two sheets; one IPSWB where it contains the Parts to be filtered, and the other is ACSWB where the logic is derived from for filtering.

My Issue arises when I need to search column B in ACSWB, for a certain feature (sub Customefeature first line).
I define what ACSWB and IPSWB are in the test macro and the DIM's are public. Is there a way to keep the defined workbooks attached to those titles? Or is there a better way of doing the search?
I can't define the workbooks again as each time the tool is run the file name/locations will be different.

VBA Code:
Public IPSFile As Variant
Public ACSFile As Variant
Public ToolWB As Workbook
Public ACSWB As Workbook
Public IPSWB As Workbook
Public SrchRng As Range, cel As Range

Sub Test_Macro()
'
' Test_Macro Macro
'
Dim IPSFile As Variant
Dim ACSFile As Variant
Dim ToolWB As Workbook
Dim ACSWB As Workbook
Dim IPSWB As Workbook
Dim SrchRng As Range, cel As Range
Dim filename As String
Set ToolWB = ThisWorkbook
Set SrchRng = Range("B13:B2000")

    'Open ACS File
    ACSFile = Application.GetOpenFilename _
    (Title:="Please choose the ACSfile to open", _
    FileFilter:="Excel Files *.xls* (*.xls*),")
    Workbooks.Open filename:=ACSFile
    Set ACSWB = ActiveWorkbook
    ' Open IPS downloaded file
    IPSFile = Application.GetOpenFilename _
    (Title:="Please choose a IPSfile to open", _
    FileFilter:="Excel Files *.xlsx* (*.xlsx*),")
    Workbooks.Open filename:=IPSFile
    Set IPSWB = ActiveWorkbook
    'Unfreeze panes
    ActiveWindow.FreezePanes = False
    'Delete Row
    Rows("12:12").Select
    Selection.Delete Shift:=xlUp
    Rows("2:9").Select
    Selection.Clear
    'fit table
    Cells.Select
    Cells.EntireColumn.AutoFit
    ACSWB.Activate
 If [B9] = "CE MARK" Then
 IPSWB.Activate
 'create filter for Pipe assy that are PED required
    Range("A12:F12").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=3, Criteria1:= _
        "=*Pipe Assy*", Operator:=xlAnd
    ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=1, Criteria1:="=*P*", _
        Operator:=xlOr
    Selection.CurrentRegion.Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    'create new sheet for Pipes and hoses
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Pipes&Hoses"
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    'Add the Meetering Valves and Shutoff Valves
    Sheets("IPSReport").Select
    ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=3
    ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=1
    ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=6, Criteria1:="=*FCE*" _
    , Operator:=xlOr
    Selection.CurrentRegion.Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Devices"
    Sheets("Devices").Select
    ActiveSheet.Paste
    Sheets("IPSReport").Select
    ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=6, Criteria1:="=*ASY2120*" _
    , Operator:=xlOr, Criteria2:="=*ASY2124*"
    Selection.CurrentRegion.Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Devices").Select
    Range("A1").End(xlDown).Offset(1).Select
    ActiveSheet.Paste
    'Check if there is a CF 0000000885 for Flex hoses to be pressure tested and CF0 0000000741 for Pressure transmitters records
    customfeatures
    ElseIf [B9] <> "CE MARK" Then
   customfeatures
    End If
    
End Sub

Sub customfeatures()
 
    ACSWB.Activate
    For Each cel In SrchRng
    If InStr(1, cel.Value, "0000000885") > 0 Then
        IPSWB.Activate
        Sheets("IPSReport").Select
        ActiveSheet.Range("$A$12:$F10000").AutoFilter Field:=3, Criteria1:= _
        "=*hose assy*", Operator:=xlAnd
         ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=1, Criteria1:="=19*", _
        Operator:=xlAnd
        Selection.CurrentRegion.Select
        Selection.Copy
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Pipes&Hoses").Select
        Range("A1").End(xlDown).Offset(1).Select
        ActiveSheet.Paste
    ElseIf InStr(1, cel.Value, "0000000741") > 0 Then
        IPSWB.Activate
        Sheets("IPSReport").Select
        ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=3
        ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=1
        ActiveSheet.Range("$A$12:$F$10000").AutoFilter Field:=6, Criteria1:="=*PT*" _
        , Operator:=xlOr, Criteria2:="=*PDT*"
        Selection.CurrentRegion.Select
        Selection.Copy
        Application.CutCopyMode = False
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        Sheets("Sheet2").Select
        Sheets("Sheet2").Name = "Devices"
        Sheets("Devices").Select
        Range("A1").End(xlDown).Offset(1).Select
        ActiveSheet.Paste
    End If
    Next cel
End Sub

I was forced to run a second sub as the For loop wasn't running in the main code.
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Your code seems to contain a lot of lines produced by the macro recorder. This is partly why it is not entirely clear what your ultimate goal is. A quick look at your code shows that a number of variables have been declared twice: at procedure level and at module level. Procedure level variables always have priority, so those at module level with the exact same name will always be undefined (ie in VBA logic: empty, nothing, "" or 0). This means your customfeatures sub would give you an error since the SrchRng variable at module level would be "Nothing".

Another note: VBA must know where to perform the intended actions. If it isn't clear which workbook / worksheet / range is targeted because it's not qualified, the intended action will be performed on the active workbook / worksheet / range. Finally, regarding the topic of this thread: within VBA it's not neccesary to activate a particular workbook or worksheet, or selecting a range. Making a proper reference will do. Whenever another procedure needs an object (workbook, sheet, range, whatever ...) such a reference can be passed on. Below a small part of your code as an example on making a proper reference as well as passing a variable on to another procedure.
VBA Code:
Sub Example()
    
    Dim ACSWB       As Workbook
    Dim ACSFile     As String
    
    'Open ACS File
    ACSFile = Application.GetOpenFilename(Title:="Please choose the ACSfile to open", FileFilter:="Excel Files *.xls* (*.xls*),")
    If Not ACSFile = "False" Then
        Set ACSWB = Workbooks.Open(filename:=ACSFile)
    Else
        MsgBox "Cancel button was pressed."
        GoTo SUB_EXIT
    End If

    Set SrchRng = ACSWB.Sheets(1).Range("B13:B2000")
    Call CustomFeatures(argRange:=SrchRng)
    
SUB_EXIT:
End Sub


Sub CustomFeatures(ByRef argRange As Range)
    Dim c   As Range
    For Each c In argRange
        ' do something
    Next c
End Sub

Hope this is of some help.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,472
Messages
5,596,353
Members
414,060
Latest member
hermanseck

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
Top