Snasui Excel Forum

Code: Select all

Sub Len_()

    Dim ws1, ws2 As Worksheet
    Dim lastRow As Long
    Dim i As Integer

    Set ws1 = Worksheets("sheet1")
    
    Set ws2 = Worksheets("sheet2")
    
    
 With ws1
 
            .AutoFilterMode = False

            .Range("A1:A1").AutoFilter

            .Range("A:A").AutoFilter Field:=1, Criteria1:="*a?b*"
            
            .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
            
With ws2

            If .Range("A1") <> "" Then
            
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial Paste:=xlPasteValues
            
        Else
        
            .Range("A1:A1").Value = ws1.Range("A1:A1").Value
            .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial Paste:=xlPasteValues
                
        End If

        Application.CutCopyMode = False
        
        ws1.AutoFilterMode = False
    

    lastRow = ws2.Range("a" & ws2.Rows.Count).End(xlUp).Row
 
            For i = 2 To lastRow
     
        If .Cells(i, "a") <> "" Then

             .Cells(i, 2).FormulaR1C1 = "=LEN(R[0]C[-1])-(LEN(SUBSTITUTE(R[0]C[-1],"","","""")))+1"
               
        End If
     
    Next i
    
            .Range("a" & lastRow + 1) = "Total:"
    
            .Range("b" & lastRow + 1) = Application.WorksheetFunction.Sum(.Range("b1:b" & lastRow))
    
            .Range("b" & lastRow + 1).Font.Bold = True
        
        End With
            
    End With
  
End Sub

Code: Select all

.Cells(i, 2).FormulaR1C1 = "=LEN(R[0]C[-1])-(LEN(SUBSTITUTE(R[0]C[-1],"","","""")))+1"

Code: Select all

Function LenAB(r As Range) As Long
    Dim t As Variant
    Dim i As Integer
    Dim icount As Integer
    t = Split(r, ",")
    For i = 0 To UBound(t)
        If t(i) Like "*a?b*" Then
            icount = icount + 1
        End If
    Next
    LenAB = icount
End Function

Code: Select all

Sub len_L()

Dim t As Variant
Dim i As Integer
Dim icount As Integer
Dim r As Range
Dim lastRow As Long

     
Sheets("sheet1").Select
     
            lastRow = Range("a" & Rows.count).End(xlUp).Row
    
    For Each r In Range("a2", Range("a" & Rows.count).End(xlUp))
    
        t = Split(r, ",")
        
         For i = 0 To UBound(t)
         
            If t(i) Like "*a?b*" Then
                
                icount = icount + 1
                
            End If
            
        Next i
        
            r.Offset(, 1).Value = icount
            
    Next r
    
            Range("a" & lastRow + 1) = "Total:"
    
            Range("b" & lastRow + 1) = Application.WorksheetFunction.Sum(Range("b1:b" & lastRow))
    
            Range("b" & lastRow + 1).Font.Bold = True
            
    
End Sub

Code: Select all

 icount = icount + 1

Code: Select all

r.Offset(, 1).Value = icount

Code: Select all

'Other code
t = Split(r, ",")
icount = 0
For i = 0 To UBound(t)
    If t(i) Like "*a?b*" Then
        icount = icount + 1
    End If
Next i
'Other code