Home > Net >  Counter is working, but how to make it list counted values?
Counter is working, but how to make it list counted values?

Time:10-27

I have a macro with counter for unique values that met specific conditions. As you can see on the image, I have list of unique values in column F. Macro checks, if value is listed in column AE (can contain duplicated lines) and checks if there is no "OB" in column AH. Then returns how many values it found in cell K2. But I need this counter to also list these values in column AD, but I am struggling to make it happen. I checked many forums and managed to crash Excel twice already. Any ideas how to achieve it?

Example

Dim myTbl As range, mStr As String, Miss As Long, xCol As Variant

Set myTbl = Sheets("OB").range("AE2")      '
xCol = "AH"

mStr = ""
Set myTbl = range(myTbl, myTbl.End(xlDown).Offset(0, 1))
xCol = Cells(1, xCol).Column - myTbl.Cells(1, 1).Column   1
For i = 1 To myTbl.Rows.count
    If myTbl.Cells(i, 1) <> "" Then
        If myTbl.Cells(i, xCol) <> "OB" And InStr(1, mStr, "##" & myTbl.Cells(i, 1), vbTextCompare) = 0 Then
            mStr = mStr & "##" & myTbl.Cells(i, 1)
            Miss = Miss   1
        End If
    End If
Next i

If Miss > 0 Then
     range("K2") = Miss & " still active"
     range("K2").Font.ColorIndex = 46

     Else
     range("K2") = "None"
     range("K2").Font.ColorIndex = 10
End If

CodePudding user response:

Please, test the next code. It, also, is able to return how many occurrences per each Value x have been found (if more than one per each exist):

Sub ExtractUniqueCondValues()
   Dim sh As Worksheet, lastR As Long, arr, i As Long, dict As Object
   
   Set sh = Sheets("OB")
   lastR = sh.Range("AE" & sh.rows.count).End(xlUp).row
   arr = sh.Range("AE2:AH" & lastR).Value
   
   Set dict = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(arr)
        If arr(i, 4) <> "OB" Then dict(arr(i, 1)) = dict(arr(i, 1))   1
   Next i

   sh.Range("K2").Value = dict.count
   sh.Range("AD2").Resize(dict.count, 1).Value = Application.Transpose(dict.Keys)
End Sub

About occurrences per each 'Value x' element, it can return in an adiacent column 'Value 2| 1 andValue 4` | 2, for your picture case... Of course, if it may have relevance for your purpose. The dictionary already keeps this data.

CodePudding user response:

Maybe using formulas is an option for you? See column G where the formula in G2 is the following and copied down.

=IF(COUNTIFS(AE:AE,F2,AH:AH,"<>OB")>0,F2,"")

Using Count or Countifs may be an option instead of VBA.

enter image description here

  • Related