Subscript out range

Navith

New Member
Joined
Mar 2, 2018
Messages
38
I am getting a subscript out range error on the line Set wsLr = Workbooks(wsName).Worksheets("F17-F18 Releases")
in the following code can any one help



Code:
Public wbSrc As Excel.Workbook
 


 Dim wsSrc As Worksheet
 Dim wsLr As Worksheet
 
 Public wsName As String
 
Private Sub Filter()
'Dim wb1 As Excel.Workbook
'Set wb1 = Workbooks.Open("C:\Users\Vibc\Downloads\cbc\Copy of PBPTReleaseBookofRecords.xlsx")
 Dim i As Date, j As Date
 Dim k As String
    i = STARTDATE.Value
    j = ENDDATE.Value
    k = LOBUNIT.Value
Dim m As Long, n As Long
m = i
n = j
Set wbSrc = Workbooks.Open("C:\Users\Vibc\Downloads\cbc\Copy of PBPTReleaseBookofRecords.xlsx")




wbSrc.Worksheets("Item Master").Activate
    
With wbSrc.Worksheets("Item Master")
wbSrc.Sheets("Item Master").Range("B4").Select
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
    ActiveSheet.AutoFilterMode = False
    
    .Rows(lastRow + 1).EntireRow.Hidden = True


    .Range("E4").AutoFilter Field:=5, Criteria1:=">=" & m _
        , Operator:=xlAnd, Criteria2:="<=" & n + 1


    .Range("E4").AutoFilter Field:=7, Criteria1:=LOBUNIT.Value


End With






End Sub


Private Function VisibleCells(rng As Range) As Range
    Dim r As Range
    For Each r In rng
        If r.EntireRow.Hidden = False Then
            If VisibleCells Is Nothing Then
                Set VisibleCells = r
            Else
                Set VisibleCells = Union(VisibleCells, r)
            End If
        End If
    Next r
End Function




'Main script
Private Sub Execute_Click()


wsName = UserForm1.WorksheetName


'Turn off flickering screen
Application.ScreenUpdating = False


 'Filter function
 Call Filter
 UserForm1.Hide




 'Search for ids
 Dim cl As Variant, rng As Range
 Dim lastRow As Long
 lastRow = 0
'Selection.SpecialCells(xlCellTypeVisible).Select
'    Sheets("Item Master").Select
 'Set rng = wbSrc.Worksheets("Item Master").Range("C:C").Cells
 'loop the usedrange
 Workbooks.Open Filename:=ThisWorkbook.Path & "" & wsName
 
' Dim rng4 As Range
' Set rng4 = selectvisiblecolc()
 For Each cl In SelectVisibleInColC()
 'rng.Cells.SpecialCells (xlCellTypeVisible)
    Dim value1 As String
    Dim value2 As String
    
    value1 = Replace(Trim(cl.Value), "-", " ")
    'Compare id with worksheet-to-extract-to's id
    Dim cl2 As Range, rng2 As Range


    'Set wsLr = Workbooks("F17-F18 Lending Releases_V1.xlsx").Worksheets("F17-F18 Releases")
    Set wsLr = Workbooks(wsName).Worksheets("F17-F18 Releases")
    Set rng2 = wsLr.Range("C:C")


    
    Set wsSrc = wbSrc.Worksheets("Item Master")
    
    Dim matchExists As Boolean
    
    matchExists = False
    
    For Each cl2 In rng2
        value2 = Replace(Trim(cl2.Value), "-", " ")
        If value1 = value2 Then
            matchExists = True
            wsLr.Cells(cl2.Row, 4).Value = wsSrc.Cells(cl.Row, 4).Value
            wsLr.Cells(cl2.Row, 8).Value = wsSrc.Cells(cl.Row, 6).Value
            wsLr.Cells(cl2.Row, 21).Value = wsSrc.Cells(cl.Row, 5).Value
            wsLr.Range(wsLr.Cells(cl2.Row, "V"), wsLr.Cells(cl2.Row, "CI")).value2 = wsSrc.Range(wsSrc.Cells(cl.Row, "AG"), wsSrc.Cells(cl.Row, "CT")).value2
        End If
    Next cl2
    
    'if there does not exist a match in the worksheet to be exported, then add the item to the bottom
    If matchExists = False Then
        Dim lRow As Long
        With wsLr
            lRow = .Cells(.Rows.Count, "F").End(xlUp).Row
            If lastRow = 0 Then
                 lastRow = lRow + 2
            Else
                 lastRow = lastRow + 1
            End If
            wsLr.Cells(lastRow, 3).Value = wsSrc.Cells(cl.Row, 3).Value
            wsLr.Cells(lastRow, 4).Value = wsSrc.Cells(cl.Row, 4).Value
            wsLr.Cells(lastRow, 8).Value = wsSrc.Cells(cl.Row, 6).Value
            wsLr.Cells(lastRow, 21).Value = wsSrc.Cells(cl.Row, 5).Value
            wsLr.Range(wsLr.Cells(lastRow, "V"), wsLr.Cells(lastRow, "CI")).value2 = wsSrc.Range(wsSrc.Cells(cl.Row, "AG"), wsSrc.Cells(cl.Row, "CT")).value2
        End With
    End If
    
    
 Next cl




Workbooks(wsName).SaveCopyAs (ThisWorkbook.Path & "\Filtered_" & wsName)


Unload UserForm1




End Sub




Private Function SelectVisibleInColC() As Range
    Dim lRow1 As Long


    With wbSrc.Sheets("Item Master")


        lRow1 = .Cells(.Rows.Count, 3).End(xlUp).Row


        If lRow1 < 3 Then Exit Function


       Set SelectVisibleInColC = .Cells(1, 3).Offset(1, 0).Resize(lRow1 - 2).SpecialCells(xlCellTypeVisible)


    End With
End Function
 
Last edited by a moderator:

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Hi & welcome to MrExcel
What is the value of wsName when you get the error?
And is that workbook open?
 
Upvote 0
I think you need a \ symbol in the quote marks here
Code:
Workbooks.Open Filename:=ThisWorkbook.Path & "" & wsName
The workbook is probably not opening because the directory is invalid. But if the file is in the same directory as ThisWorkbook then you only need this.
Code:
Workbooks.Open Filename:=wsName
 
Last edited:
Upvote 0
the worksheet is opening correctly, the subscript out of range debug points to the following line
Set wsLr = Workbooks(wsName).Worksheets("F17-F18 Releases")
 
Upvote 0
Do the workbook & worksheet have the same names?
 
Upvote 0
1.JPG
 
Upvote 0
This line of code (albeit commented out) would tend to suggest otherwise
Code:
Set wsLr = Workbooks("F17-F18 Lending Releases_V1.xlsx").Worksheets("F17-F18 Releases")
Run this & what does the msgbox say
Code:
Sub chk()
MsgBox "|" & ActiveSheet.Name & "|" & vbLf & ActiveWorkbook.Name

End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

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