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:
Typo Colour should be Color
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Forum statistics

Threads
1,215,077
Messages
6,122,995
Members
449,094
Latest member
masterms

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