When autofilter = true, error adding comment to a cell...

**michaeljoeyeager** · 08-01-2012, 10:39 AM

Friends, I have a userform that sends information to a row, and one of the fields from the userform gets sent to a comment box. I also have a filter macro that uses autofilter to hide certain rows that the user chooses.

The userform works great unless the filter macro has been used. If the filters are on and I try to add a new row I get an error at this line...

                    ActiveCell.Offset(0, 6).AddComment (FullBox.Value)

But I can then remove the filters and it works again.

Any idea why?

Thanks in advance,

Mike

**bonny24tycoon** · 08-01-2012, 11:00 AM

We might need to look at the rest of the code to determine...

**michaeljoeyeager** · 08-01-2012, 11:31 AM

Ok here is the code for OKButton Click on the userform. When the filter is not enabled it works fine.

Private Sub OKButton_Click()
ActiveSheet.Unprotect
Application.ScreenUpdating = False






If UpdatedByBox.Value <> "" Then

    If USToggle.Value = True Or ThemToggle.Value = True Then
    
        If IsDate(DateBox.Value) = True Then

            If Range("A6").Value = "" Then

                Range("A6").Value = ControlBox.Value
                Range("B6").Value = ProjectBox.Value
                Range("C6").Value = HighwayBox.Value
                Range("D6").Value = ContractorBox.Value
                Range("E6").Value = RFINumberBox.Value
                Range("F6").Value = SubjectBox.Value
        
                    If Not FullBox.Value = "" Then
                    
                        Range("G6").AddComment (FullBox)
           
                        With Range("G6").Comment
                        .Shape.TextFrame.AutoSize = True
                        shapeArea = .Shape.Width * .Shape.Height
                        .Shape.Width = 200
                        .Shape.Height = 800
                        End With
      
                    Else
     
                    End If

                    If USToggle.Value = True Then
                    
                        Range("H6").Value = "US"
                  
                    ElseIf ThemToggle.Value = True Then
                   
                        Range("H6").Value = "THEM"
                    
                    Else
                    
                    End If
            
                Range("I6").Value = DateBox.Value
            
                    If IsDate(NeedByBox.Value) = True Then
            
                        Range("J6").Value = NeedByBox.Value
                        Range("K6").FormulaR1C1 = "=IF(RC[-1]>R2C10, DATEDIF(R2C10,RC[-1], ""D""), DATEDIF(RC[-1],R2C10, ""d""))"
            
                    Else
            
                    End If
                    
                Range("L6").Value = AssignedToBox.Value
                Range("M6").Value = "NO"
                Range("N6").Value = UpdatedByBox.Value
    
            Else
    
                Application.ScreenUpdating = False
                Range("A5:A1048576").End(xlDown).Offset(1).Select
                ActiveCell.Value = ControlBox.Value
                ActiveCell.Offset(0, 1).Value = ProjectBox.Value
                ActiveCell.Offset(0, 2).Value = HighwayBox.Value
                ActiveCell.Offset(0, 3).Value = ContractorBox.Value
                ActiveCell.Offset(0, 4).Value = RFINumberBox.Value
                ActiveCell.Offset(0, 5).Value = SubjectBox.Value
   
                If Not FullBox.Value = "" Then
            
                    ActiveCell.Offset(0, 6).AddComment (FullBox.Value)
                  
                    With ActiveCell.Offset(0, 6).Comment
                    .Shape.TextFrame.AutoSize = True
                    shapeArea = Len(.Text)
                    .Shape.Width = 200
                    .Shape.Height = 800
                    End With
            
                Else
        
                End If
    
                If USToggle.Value = True Then
    
                    ActiveCell.Offset(0, 7).Value = "US"
        
                ElseIf ThemToggle.Value = True Then
    
                    ActiveCell.Offset(0, 7).Value = "THEM"
        
                Else
        
                End If
    
                If IsDate(NeedByBox.Value) = True Then
    
                ActiveCell.Offset(0, 9).Value = NeedByBox.Value
                ActiveCell.Offset(0, 10).FormulaR1C1 = "=IF(RC[-1]>R2C10, DATEDIF(R2C10,RC[-1], ""D""), DATEDIF(RC[-1],R2C10, ""d""))"
        
                Else
        
                End If
    
                ActiveCell.Offset(0, 8).Value = DateBox.Value
                ActiveCell.Offset(0, 11).Value = AssignedToBox
                ActiveCell.Offset(0, 12).Value = "NO"
                ActiveCell.Offset(0, 13).Value = UpdatedByBox.Value
       
    
            End If
            
        Else
        
            MsgBox ("You must enter a valid start date to continue.")
            DateBox.SetFocus
            With DateBox
            .SelStart = 0
            .SelLength = Len(.Text)
            End With
            Exit Sub
            
        End If
        
    Else
    
    MsgBox ("Please select a BIC value to continue.")
    
    Exit Sub
    
    End If
    
Else

MsgBox ("Please enter your initials to proceed.")

UpdatedByBox.SetFocus

Exit Sub

End If



UserForm1.Hide
Unload UserForm1

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
Comments_AutoSize
End Sub

And this is the code for the filter macro...


Option Explicit

Dim rngData As Range

Private Sub AnsweredAdd_Click()
AddFilter "AnsweredCombo", "AnsweredList"
End Sub

Private Sub AnsweredDelete_Click()
RemoveFilter "AnsweredList"
End Sub

Private Sub AssignedAdd_Click()
AddFilter "AssignedCombo", "AssignedList"
End Sub

Private Sub AssignedDelete_Click()
RemoveFilter "AssignedList"
End Sub

Private Sub BICAdd_Click()
AddFilter "BICCombo", "BICList"
End Sub

Private Sub BICDelete_Click()
  RemoveFilter "BICList"
End Sub


Private Sub CommandButton1_Click()
ApplyFilter True
End Sub

Private Sub ContractorAdd_Click()
AddFilter "ContractorCombo", "ContractorList"
End Sub

Private Sub ContractorDelete_Click()
RemoveFilter "ContractorList"
End Sub

Private Sub CSJAdd_Click()
AddFilter "CSJCombo", "CSJList"
End Sub

Private Sub CSJDelete_Click()
RemoveFilter "CSJList"
End Sub

Private Sub HighwayAdd_Click()
AddFilter "HighwayCombo", "HighwayList"
End Sub

Private Sub HighwayDelete_Click()
RemoveFilter "HighwayList"
End Sub
Private Sub ProjectAdd_Click()
AddFilter "ProjectCombo", "ProjectList"
End Sub

Private Sub ProjectDelete_Click()
RemoveFilter "ProjectList"
End Sub


Private Sub UserForm_Initialize()
    With ActiveWorkbook.ActiveSheet
        Set rngData = .Range("A5", .Cells(Rows.Count, "M").End(xlUp))
        ApplyFilter
    End With
End Sub

Private Function ApplyFilter(Optional ByVal bKeepFilter As Boolean = False)
    
    Dim ctrl As Control
    Dim wsList As Worksheet
    Dim VisCell As Range
    Dim colList As Object
    Dim arrList() As Variant
    Dim arrFilterData() As Variant
    Dim i As Long, j As Long
    Dim strCBO As String
    
    Set wsList = Sheets("Lists")
    Application.ScreenUpdating = False
    
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ListBox" Then
            If ctrl.ListCount > 0 Then
                ReDim arrFilterData(1 To ctrl.ListCount)
                For i = 1 To ctrl.ListCount
                    arrFilterData(i) = ctrl.List(i - 1)
                Next i
                rngData.AutoFilter ctrl.Tag, arrFilterData, xlFilterValues
                Erase arrFilterData
            End If
        End If
    Next ctrl
    
    If bKeepFilter = False Then
        On Error Resume Next
        For i = 1 To 7
            strCBO = Choose(i, "CSJCombo", "ProjectCombo", "HighwayCombo", "ContractorCombo", "BICCombo", "AssignedCombo", "AnsweredCombo")
            Set colList = New Collection
            For Each VisCell In rngData.Offset(, Me.Controls(strCBO).Tag - 1).Resize(, 1).SpecialCells(xlCellTypeVisible).Cells
                If VisCell.Row > 5 Then
                    colList.Add VisCell.Text, VisCell.Text
                End If
            Next VisCell
            With Me.Controls(strCBO)
                .Clear
                If colList.Count > 0 Then
                    ReDim arrList(1 To colList.Count)
                    For j = 1 To colList.Count
                        arrList(j) = colList(j)
                    Next j
                    With wsList.Range("A1").Resize(UBound(arrList))
                        .Value = Application.Transpose(arrList)
                        .Sort .Cells, xlAscending, Header:=xlNo
                        arrList = Application.Transpose(.Value)
                        .ClearContents
                    End With
                    .List = arrList
                    Erase arrList
                End If
            End With
            Set colList = Nothing
        Next i
        On Error GoTo 0
        
        rngData.AutoFilter
        Set wsList = Nothing
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = True
        Unload Me
    End If
    
End Function

Private Function AddFilter(ByVal strCBO As String, ByVal strList As String)
    
    With Me.Controls(strCBO)
        If .ListIndex > -1 Then
            Me.Controls(strList).AddItem .List(.ListIndex)
            ApplyFilter
        End If
    End With
    
End Function

Private Function RemoveFilter(ByVal strList As String, Optional ByVal bClearAll As Boolean = False)
    
    Dim i As Long
    
    With Me.Controls(strList)
        If bClearAll = False Then
            If .ListIndex > -1 Then
                .RemoveItem .ListIndex
                ApplyFilter
            End If
        Else
            For i = .ListCount - 1 To 0 Step -1
                .RemoveItem i
            Next i
            ApplyFilter
        End If
    End With
    
End Function