Method of Range Class Failed (Over and Over again)

[lwoolley]

Hi,


I am creating a user form with a couple of list boxes. When you select a line of data in the first listbox, the second listbox should populate with comments based on a unique identifier. This works fine when you run the first bit of code below on its own, but if I filter the data in the first list box, I suddenly get the 'Method of Range Class Failed' debug.


I have tried to use advanced filter and auto filter, but both seem to get the same error. I have tried selecting and activating the sheet before applying the filter but this does not help. When I step through the code, and it runs the Sheets("XXX").Activate, it does not activate the sheet. But I can not work out why.


My userform is opened as VBModeless.


Can anyone help me work out why this is happening and how to stop it?




First piece of code, which runs fine on its own.

 Sub PopulateComments()


Dim r As Integer
Dim filtercri As String


r = ListBox1.ListIndex


filtercri = ListBox1.List(r, 0)


ThisWorkbook.Sheets("ItemCommentsV").Range("A:D").Value = ""


ListBox2.RowSource = ""


ThisWorkbook.Sheets("Filter Values").Range("A2").Value = filtercri


ThisWorkbook.Sheets("ItemComments").Range("A:D").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=ThisWorkbook.Sheets("Filter Values").Range("A1:D2"), _
CopyToRange:=ThisWorkbook.Sheets("ItemCommentsV").Range("A:D")




ThisWorkbook.Sheets("ItemCommentsV").Range("C:C").NumberFormat = "dd/mm/yyyy hh:mm;@"


Dim row199 As Integer


If ThisWorkbook.Sheets("ItemCommentsV").Range("A3").Value = "" Then


    row199 = 2


Else


    row199 = ThisWorkbook.Sheets("ItemCommentsV").Range("A1").End(xlDown).Row


End If


ThisWorkbook.Sheets("ItemCommentsV").Activate


With ListBox2
    .ColumnHeads = True
    .ColumnCount = 4
    .ColumnWidths = "0;0;50;50"
    .RowSource = ThisWorkbook.Sheets("ItemCommentsV").Range("A2:D" & row199).Address
End With


ThisWorkbook.Sheets("ItemComments").AutoFilterMode = False


End Sub

This is the piece of code which if it is run first, makes the above code error.

 Sub ApplyFilter()


Application.ScreenUpdating = False


'Windows("Technical Team Backlog.xlsm").Visible = True


ThisWorkbook.Sheets("Current Sprint").AutoFilterMode = False


ThisWorkbook.Sheets("Current Sprint").Range("A:X").AutoFilter Field:=22, Criteria1:=UserForm9.ComboBox1.Value


ThisWorkbook.Sheets("ListBoxSheet").Range("A1:AA50000").Clear


ThisWorkbook.Sheets("Current Sprint").AutoFilter.Range.Copy


ThisWorkbook.Sheets("ListBoxSheet").Range("A1").PasteSpecial xlPasteValues


ThisWorkbook.Sheets("ListBoxSheet").Range("O:O").NumberFormat = "dd/mm/yyyy"


ThisWorkbook.Sheets("Current Sprint").AutoFilterMode = False


ThisWorkbook.Sheets("ListBoxSheet").Activate


If ThisWorkbook.Sheets("Listboxsheet").Range("A2") = "" And isclearing <> True Then
    
    MsgBox "Nothing found in this sprint for " & UserForm9.ComboBox1.Value & "."
    
    UserForm9.ListBox1.RowSource = ""


    Exit Sub
End If


If ComboBox1.Value <> "" Then


Dim row156 As Integer


    row156 = ThisWorkbook.Sheets("ListBoxSheet").Range("A1").End(xlDown).Row
    
    With ListBox1
        .ColumnHeads = True
        .ColumnCount = 24
        .ColumnWidths = "50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;40;50;40;45;40;50;60;70;70"
        .RowSource = ThisWorkbook.Sheets("ListBoxSheet").Range("A2:Y" & row156).Address
    End With






    TextBox1.Value = WorksheetFunction.Sum(ThisWorkbook.Sheets("ListBoxSheet").Range("T:T"))
    
    TextBox2.Value = WorksheetFunction.SumIf(ThisWorkbook.Sheets("ListBoxSheet").Range("W:W"), "Complete", ThisWorkbook.Sheets("ListBoxSheet").Range("T:T"))
    
    TextBox3.Value = Format(TextBox2.Value / TextBox1.Value, "Percent")
    
Else


TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""




End If


ThisWorkbook.Sheets("Current Sprint").AutoFilterMode = False


End Sub

Thanks in advance for your help!

 

[Norie]

Which line of code is causing the error?

 

[lwoolley]

Hi, it's the below bit of code that is not working.

ThisWorkbook.Sheets("ItemComments").Range("A:D").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=ThisWorkbook.Sheets("Filter Values").Range("A1:D2"), _
CopyToRange:=ThisWorkbook.Sheets("ItemCommentsV").Range("A:D")

But I will get the same error type if I try and use autofilter.

 

[Norie]

Why are you using entire columns for the CopyToRange?

Does this work?

ThisWorkbook.Sheets("ItemComments").Range("A:D").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=ThisWorkbook.Sheets("Filter Values").Range("A1:D2"), _
CopyToRange:=ThisWorkbook.Sheets("ItemCommentsV").Range("A1")

 

[lwoolley]

Hi, I have tried this and it is still not working. Still getting the same error. It works when run on its own, but not when the other code is run first.

It is like the macro can not access the sheet. Is there a setting or something that could stop the macro from being able to interact with the sheet?

Would it help if I was to upload the full excel file, with example data?

Thanks, Lewis

 

[Norie]

Lewis

I can't see any real connection between the 2 sets of code, they don't even appear to refer to the same sheets.

Are the sheets connected in some way?

By the way, you mention that you want to find a unique ID to pull the comments, which column are the IDs in on the ItemComments sheet?

 

[lwoolley]

Hi Norie,

They don't refer to the same sheets which is the strange thing! No the sheets are not connected.

The 'Current Sprint' is where a user would find their current work load. When an item of work is selected in the listbox within a userform, the second list box should populate. This works find, until the 'Current Sprint' is filtered on the user. Then the second list box won't populate.

The unique IDs are in column A in ItemComments. I should have mentioned that the IDs are unique to the work item, not to the comments. Each work item will have a set of comments.

I have a blank work book, with example data ready now if that helps.

Thanks, Lewis

 

[Norie]

What I'm thinking, and it might not suit your purposes, is to ditch the filter and add code to return the comments for the ID.

Something like this.

Sub PopulateComments()
Dim wsComments As Worksheet
Dim arrIn As Variant
Dim arrOut As Variant
Dim filtercri As String
Dim I As Long
Dim J As Long
Dim cnt As Long
    
    filtercri = ListBox1.List(ListBox1.ListIndex, 0)

    ListBox2.RowSource = ""

    Set wsComments = ThisWorkbook.Sheets("ItemComments")

    arrIn = wsComments.UsedRange.Resize(, 4).Value
    
    ReDim arrOut(1 To UBound(arrIn), 1 To UBound(arrIn, 2))

    For I = LBound(arrIn) To UBound(arrIn)
        If arrIn(I, 1) = filtercri Then
            cnt = cnt + 1
            For J = LBound(arrIn, 2) To UBound(arrIn, 2)
                arrOut(cnt, J) = arrIn(I, J)
            Next J
        End If
    Next I
            
    If cnt > 0 Then
        arrOut = Application.Transpose(arrOut)
        
        ReDim Preserve arrOut(1 To UBound(arrOut), 1 To cnt)
        
        With ListBox2
            .ColumnCount = 4
            .ColumnWidths = "0;0;50;50"
            .Column = arrOut
        End With
        
    End If
    
End Sub

Note, with the above you won't get column headers but if you really wanted them you could transfer the data, plus the header row, to the ItemCommentsV sheet and populate the listbox from there.

 

[lwoolley]

I will give this a try now and come back to you. Thanks!

 

[lwoolley]

That seems to be working perfectly! Thank you so much for your help!

I am going to do some more testing, but for now, it does just what I need it to!