VBA: looping in an array and select the corresponding value

[Nelson78]

Hello everybody.

I've a situation as follows.

https://imgur.com/HLpoOUH


Then, in sheet "Data" I have two values:
cell A2 = 7210210
cell A3 = 7210214

Now, I've to loop in this array and write in B2 = 2958 (corresponding to 7210210) and in B3 = 1020 (corresponding to 7210214).

How can I perform this task?


Thank's in advance.

 

[Fluff]

Ok, try

Sub Nelson78()
   
   Dim vData As Variant
   Dim vOutput() As Variant
   Dim vKey
   Dim dicCount As Object
   Dim i As Long, j As Long
   Dim lr As Long
   
   Set dicCount = CreateObject("scripting.dictionary")

   With Sheets("pcode")
      lr = .Cells(Rows.count, "H").End(xlUp).Row
      vData = .Range("D2:K" & lr).Value2
      
      For i = LBound(vData, 1) + 1 To UBound(vData, 1)
         If Not dicCount.Exists(vData(i, 8)) Then dicCount.Add vData(i, 8), CreateObject("scripting.dictionary")
         dicCount(vData(i, 8))(vData(i, 7)) = dicCount(vData(i, 8))(vData(i, 7)) + 1
      Next i
      
      ReDim vOutput(1 To dicCount.count, 1 To 2)
      i = 1
      For Each vKey In dicCount.Keys
         vOutput(i, 1) = vKey
         vOutput(i, 2) = dicCount(vKey).count
         i = i + 1
      Next vKey
   End With
End Sub

 

[Fluff]

Forgot the original question.
Try

Sub Nelson78()
   
   Dim vData As Variant
   Dim dicCount As Object
   Dim i As Long
   Dim lr As Long
   
   Set dicCount = CreateObject("scripting.dictionary")

   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      lr = .Cells(Rows.count, "H").End(xlUp).Row
      vData = .Range("D2:K" & lr).Value2
   End With
   For i = LBound(vData, 1) + 1 To UBound(vData, 1)
      If Not dicCount.Exists(vData(i, 8)) Then dicCount.Add vData(i, 8), CreateObject("scripting.dictionary")
      dicCount(vData(i, 8))(vData(i, 1)) = Empty
   Next i
   With Sheets("[COLOR=#ff0000]Summary[/COLOR]")
      .Range("B1").Value = dicCount(.Range("A1").Value).count
      .Range("B2").Value = dicCount(.Range("A2").Value).count
   End With
End Sub

Change names in red to suit

 

[Nelson78]

Forgot the original question.
Try

Sub Nelson78()
   
   Dim vData As Variant
   Dim dicCount As Object
   Dim i As Long
   Dim lr As Long
   
   Set dicCount = CreateObject("scripting.dictionary")

   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      lr = .Cells(Rows.count, "H").End(xlUp).Row
      vData = .Range("D2:K" & lr).Value2
   End With
   For i = LBound(vData, 1) + 1 To UBound(vData, 1)
      If Not dicCount.Exists(vData(i, 8)) Then dicCount.Add vData(i, 8), CreateObject("scripting.dictionary")
      dicCount(vData(i, 8))(vData(i, 1)) = Empty
   Next i
   With Sheets("[COLOR=#ff0000]Summary[/COLOR]")
      .Range("B1").Value = dicCount(.Range("A1").Value).count
      .Range("B2").Value = dicCount(.Range("A2").Value).count
   End With
End Sub

Change names in red to suit

Something is wrong.

Run Time Error '424' object required

in line

.Range("B1").Value = dicCount(.Range("A1").Value).count

 

[Fluff]

Try

   With Sheets("Summary")
      If dicCount.Exists(.Range("A1").Value) Then .Range("B1").Value = dicCount(.Range("A1").Value).Count
      If dicCount.Exists(.Range("A2").Value) Then .Range("B2").Value = dicCount(.Range("A2").Value).Count
   End With

 

[Nelson78]

Try

   With Sheets("Summary")
      If dicCount.Exists(.Range("A1").Value) Then .Range("B1").Value = dicCount(.Range("A1").Value).Count
      If dicCount.Exists(.Range("A2").Value) Then .Range("B2").Value = dicCount(.Range("A2").Value).Count
   End With

Well, now it works fine.

Thank's a lot.

 

[Fluff]

You're welcome & thanks for the feedback