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:
One line of Data in each file is not enough to test, what is going wrong. Especially when you are checking col C in each file & the one entry you've supplied is completely different in each file.
Could you please supply some more representative files?
 
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
One line of Data in each file is not enough to test, what is going wrong. Especially when you are checking col C in each file & the one entry you've supplied is completely different in each file.
Could you please supply some more representative files?


https://drive.google.com/open?id=1Xk9CzEUqwVx6sd3O6mkVGDyRHtuBQIUp
https://drive.google.com/open?id=1OWBVQYrMHQmam8yIiVHjhyv4hGkiD1Zl

I have deleted non relevant columns from the right to avoid confusion what I have shared before Source excel file.
 
Last edited:
Upvote 0
Ok, try this
Code:
Private Sub Execute_Click()
   Dim Rng As Range
   Dim rng2 As Range
   Dim NxtRw As Long
   Dim Fnd As Range
   wsName = UserForm1.WorksheetName
   
   
   'Turn off flickering screen
   Application.ScreenUpdating = False
   
   
    'Filter function
    Call Filter
    UserForm1.Hide
   
    'Search for ids
    
   Workbooks.Open FileName:=ThisWorkbook.Path & "\" & wsName
   Set wsLr = Workbooks("F17-F18 Lending Releases.xlsx").Worksheets("F17-F18 Releases")
   Set rng2 = wsLr.Range("B2", wsLr.Range("B" & Rows.Count).End(xlUp))
   Set wsSrc = wbSrc.Worksheets("Item Master")
   
   NxtRw = wsLr.Cells(wsLr.Rows.Count, "B").End(xlUp).Offset(1).Row
   
   For Each Rng In SelectVisibleInColC()
      Set Fnd = rng2.Find(Rng.Value, , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         Fnd.Offset(, 1).Value = Rng.Offset(, 1).Value
         Fnd.Offset(, 5).Value = Rng.Offset(, 3).Value
         Fnd.Offset(, 19).Value = Rng.Offset(, 2).Value
         Intersect(Fnd.EntireRow, wsLr.Range("V:CI")).Value = Intersect(Rng.EntireRow, wsSrc.Range("AG:CT")).Value
      Else
         wsLr.Cells(NxtRw, 2).Value = wsSrc.Cells(Rng.Row, 3).Value
         wsLr.Cells(NxtRw, 4).Value = wsSrc.Cells(Rng.Row, 4).Value
         wsLr.Cells(NxtRw, 8).Value = wsSrc.Cells(Rng.Row, 6).Value
         wsLr.Cells(NxtRw, 21).Value = wsSrc.Cells(Rng.Row, 5).Value
         wsLr.Range(wsLr.Cells(NxtRw, "V"), wsLr.Cells(NxtRw, "CI")).Value = wsSrc.Range(wsSrc.Cells(Rng.Row, "AG"), wsSrc.Cells(Rng.Row, "CT")).Value
         NxtRw = NxtRw + 1
      End If
   Next Rng


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(5, 3).Resize(lRow1 - 2).SpecialCells(xlCellTypeVisible)


    End With
End Function
 
Upvote 0
it works fine with some changes here is the final code. I used added some more cells to copy from the master. the question about subscript out of range resolved by providing workbook name with extension (.xlsx)

Code:
Private Sub Execute_Click()
   Dim Rng As Range
   Dim rng2 As Range
   Dim NxtRw As Long
   Dim Fnd As Range
   wsName = UserForm1.WorksheetName
   
   
   'Turn off flickering screen
   Application.ScreenUpdating = False
   
   
    'Filter function
    Call Filter
    UserForm1.Hide
   
    'Search for ids
    
   Workbooks.Open Filename:=ThisWorkbook.Path & "\" & wsName
   Set wsLr = Workbooks(wsName).Worksheets("F17-F18 Releases")
   Set rng2 = wsLr.Range("B2", wsLr.Range("B" & Rows.Count).End(xlUp))
   Set wsSrc = wbSrc.Worksheets("Item Master")
   
   NxtRw = wsLr.Cells(wsLr.Rows.Count, "B").End(xlUp).Offset(1).Row
   
   For Each Rng In SelectVisibleInColC()
      Set Fnd = rng2.Find(Rng.Value, , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         Fnd.Offset(, 1).Value = Rng.Offset(, 1).Value
         Fnd.Offset(, 6).Value = Rng.Offset(, 3).Value
         Fnd.Offset(, 19).Value = Rng.Offset(, 2).Value
         Intersect(Fnd.EntireRow, wsLr.Range("V:CL")).Value = Intersect(Rng.EntireRow, wsSrc.Range("Y:CO")).Value
      Else
         wsLr.Cells(NxtRw, 2).Value = wsSrc.Cells(Rng.Row, 3).Value
         wsLr.Cells(NxtRw, 3).Value = wsSrc.Cells(Rng.Row, 4).Value
         wsLr.Cells(NxtRw, 4).Value = wsSrc.Cells(Rng.Row, 7).Value
         wsLr.Cells(NxtRw, 5).Value = wsSrc.Cells(Rng.Row, 9).Value
         wsLr.Cells(NxtRw, 8).Value = wsSrc.Cells(Rng.Row, 6).Value
         wsLr.Cells(NxtRw, 21).Value = wsSrc.Cells(Rng.Row, 5).Value
         wsLr.Range(wsLr.Cells(NxtRw, "V"), wsLr.Cells(NxtRw, "CL")).Value = wsSrc.Range(wsSrc.Cells(Rng.Row, "Y"), wsSrc.Cells(Rng.Row, "CO")).Value
         NxtRw = NxtRw + 1
      End If
   Next Rng


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(5, 3).Resize(lRow1 - 2).SpecialCells(xlCellTypeVisible)


    End With
End Function
 
Upvote 0
Thanks for the help, I planning to modify the code later to add more functionality to the user form like adding drop down to user form (LOB unit). highlight updated cells in the output file.
 
Last edited:
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
How about
Code:
   If Not Fnd Is Nothing Then
      Fnd.Offset(, 1).Value = Rng.Offset(, 1).Value
      Fnd.Offset(, 6).Value = Rng.Offset(, 3).Value
      Fnd.Offset(, 19).Value = Rng.Offset(, 2).Value
      Intersect(Fnd.EntireRow, wsLr.Range("V:CL")).Value = Intersect(Rng.EntireRow, wsSrc.Range("Y:CO")).Value
     [COLOR=#ff0000] Fnd.EntireRow.Interior.colour = 456789[/COLOR]
   Else
Add the line in red & change the number to whatever colour you want
 
Upvote 0
How about
Code:
   If Not Fnd Is Nothing Then
      Fnd.Offset(, 1).Value = Rng.Offset(, 1).Value
      Fnd.Offset(, 6).Value = Rng.Offset(, 3).Value
      Fnd.Offset(, 19).Value = Rng.Offset(, 2).Value
      Intersect(Fnd.EntireRow, wsLr.Range("V:CL")).Value = Intersect(Rng.EntireRow, wsSrc.Range("Y:CO")).Value
     [COLOR=#ff0000] Fnd.EntireRow.Interior.colour = 456789[/COLOR]
   Else
Add the line in red & change the number to whatever colour you want

Run time error : 438 : object doesn't support this property or method
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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