0
votes
Sub Auto_Open()
Application.ScreenUpdating = False

Dim count4u As Long  
Dim count4g As Long  
...

Dim i As Double
i = 4

 count4u = 0
 count4g = 0
 count4t = 0
...

Sheets("data").Select



Do While Cells(i, 3).Value <> ""
 Cells(i, 3).Activate

 If Left(ActiveCell.Value, 3) = "CP1" Then


        If Mid(ActiveCell.Value, 4, 1) = "U" Then
    count4u = count4u + 1

     ElseIf Mid(ActiveCell.Value, 4, 1) = "G" Then
        count4g = count4g + 1

    ElseIf Mid(ActiveCell.Value, 4, 1) = "T" Then
    count4t = count4t + 1

    ElseIf Mid(ActiveCell.Value, 4, 1) = "B" Then
    count4b = count4b + 1

    ElseIf Mid(ActiveCell.Value, 4, 1) = "F" Then
    count4f = count4f + 1

  ElseIf Mid(ActiveCell.Value, 4, 1) = "C" Then
    count4c = count4c + 1
End If

 ...





i = i + 1
Loop

Worksheets("Base").Activate
Range("X6") = count4u
...
Call cp2count


End Sub

I have tried a couple of different solutions, one trying to use a for each loop and Range("C4", Range("C4").End(xldown)).SpecialCells(xlCellTypeVisible). The other time i just tried selecting the cells with specialcells(xlcelltypevisible) and loop through it the way I have it. I am having a problem being able to count the character in the 4th/5th position without using the activecell function.

1
You know this can be done with formulas? Is the VBA necessary?Scott Craner
My workbook generates a report to filter pivot tables based on user input (my data table is not static). I have vba code that will change the filters to the data table, and I need to count the results of what is filtered.WannaBeMathGeek
also how would you do this without a formula? how would the left function work? you can only reference one cell when doing so. Ex countif(range(left("text" you would be stuck here because you cannot reference the range, only one cellWannaBeMathGeek

1 Answers

0
votes

If you don't want do do this directly in Excel with an ArrayFormula, then VBA would want to use Range Areas:

Dim rToCheck As Range, rArea As Range, rCell AS Range
Dim count4u AS Long, count4 AS Long

count4u = 0
count4g = 0

Set rToCheck = Application.Intersect(ThisWorkbook.Worksheets("data").UsedRange,ThisWorkbook.Worksheets("data").Columns(3).SpecialCells(xlCellTypeVisible))

If Not(rToCheck Is Nothing) Then 'Make sure we have visible cells!
    For Each rArea In rToCheck
        For Each rCell In rArea
            Select Case Left(rCell.Value,4)
                Case "CP1U"
                    count4u = count4u + 1
                Case "CP1G"
                    count4g = count4g + 1
            End Select
        Next rCell
    Next rArea
End If

Worksheets("Base").Cells(6,24) = count4u 'Cells(6,24) is Range("X6")

Set rToCheck = Nothing
Set rArea = Nothing
Set rCell = Nothing