Count cells in a dynamic range, calculate their percentage in respect to total cells.

[DimitriosNikolouzos]

Hi all,

I'm quite new in programming and i have this question.


There are 3 columns (from left to right):
1) IPM Project Name
2) EAN CODE
3) Feasibility: each EAN CODE has feasibility right next to it. It could be "Matched", "Matched & Robust" , NA etc

My code:
starts from cells(2,1) with rng as Range, moves right until it finds the EAN CODE column and moves downwards, until it finds a cell which is not empty.
When it does, moves left until it finds the IPM Project name column.


IPMrng asRange


What i intend to achieve:
move down, and for all project names that are the same ( IPMrng.offset(1,0) ), look into the range.offset(0,1) which is the Feasibility column and count how many times "Matched" or "Matched & Robust" categories occur for that IPM Project Name.
If they occur >50% of the Total categories in the Feasibility column, then type next to it rng.offset(0,2) something like Yes, or No.


The Count process is not very clear to me and it is definitely wrong. Any help would be highly appreciated.

Note: I typed rng.select several time to visualize the whole process while stepping through the code. Also added Message Boxes to see how the code works/


Attachment 611875

Sub count_test()

Dim datash As Worksheet
Dim rng As Range, IPMrng As Range
Dim i As Long
Dim j As Long


Set datash = ActiveSheet
Set rng = datash.Cells(2, 1)
rng.Select




Do Until rng.Offset(-1, 0) = "EAN CODE"        'starts from left to right til it finds the right column.
    Set rng = rng.Offset(0, 1)

    rng.Select

Loop

Set rng = datash.Cells(2, 14)     'this is the ActiveCell


Do Until rng.Offset(0, -1) = ""     'a column on its left
Set rng = rng.Offset(1, 0)

    If rng = "" Then
        
        Set rng = rng.Offset(1, 0)
        rng.Select
        
    Else
        
        ' selects the 1st EAN CODE
        rng.Select
        
        ' setting the range for IPM Project Name
        Set IPMrng = rng.Offset(0, -9)
        IPMrng.Select
        
        i = 0
        j = 0
        
        Do Until IPMrng <> IPMrng.Offset(1, 0)
                
            Do Until IPMrng = IPMrng.Offset(1, 0) Or IPMrng = IPMrng.Offset(-1, 0)
                               
                                    'Counts the various Statuses
                    If UCase(ActiveSheet.Cells(rng.Row, rng.Column)) Like "*Matched*" Or UCase(ActiveSheet.Cells(rng.Row, rng.Column)) Like "*Matched & Robust*" Then
                                   
                        i = i + 1
                        MsgBox i
                            
                    Else
                        j = j + 1
                        MsgBox j
                    
                    End If
                        
            Set IPMrng = IPMrng.Offset(1, 0)
            IPMrng.Select
                    
            Loop
                           
        Loop
        
        
            ' Checks if the sum of (Matched + Matched & Robust) is ** Greater Than 50% ** of the total status
            ' If Yes, then Report
            ' If No, then Do not Report
                
            If i >= 0.5 * j Then
            
                rng.Offset(0, 3) = "Yes"
                
            Else
            
                rng.Offset(0, 3) = "No"
            
            End If
        
        End If
                
    End If
    
Loop

  

End Sub