if item exists in array of scripting dictionary

[tomleitch]

Hi all,

I have some code that makes a scripting dictionary but I'm having a bit of a problem with trying to get it to do what I want.

Here's my code that's throwing up an error:

   With CreateObject("scripting.dictionary")
  
 Set ws2 = Sheets("UPDATE TOOL3")
  
   For Each cl In ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp))
        
        If Not .exists(cl.Value) Then
                .Add cl.Value, Array(cl.Offset(, 1).Value, cl.Offset(, 2).Value, cl.Offset(, 3).Value)
                
                
           End If
          
          
            Next cl
 
                Set ws1 = Sheets("MAINT")


                For Each cl2 In ws1.Range("A10", ws1.Range("A" & Rows.Count).End(xlUp))
                
                If .exists.Item(cl.Value)(0)) Then
                
                etc...........

It's this bit that is giving me the trouble " If .exists.Item(cl.Value)(0)) Then"


Any help much appreciated,

Thanks
Tom

 

[tomleitch]

It's not easy to explain.

I've put a shot of the two sheets along with a bit of explanation

So sheet 1 is just data that I want to get and use

Sheet 2 is the one that i want to write and edit based on what is on sheet 1 in the columns B and C

 

[DanteAmor]

Ok, then look for the data in column A of sheet2, in column A of sheet1 and I get column B and C of sheet1.
But what do you want to do with the data in columns B and C of sheet1?
That is important to know, to analyze where to store the result.

 

[DanteAmor]

From what I understand, it is not necessary to create a dictionary, since in column A of sheet2 you have unique values.

The following takes each value from column A of sheet2 and searches for it in column A of sheet1 all matches are stored in array ary3.

Sub Search_Items()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim ary1 As Variant, ary2 As Variant, ary3 As Variant
  Dim i As Long, j As Long, k As Long
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
 
  'load data from sheet1 (columns A-C) into array ary1
  ary1 = sh1.Range("A2:C" & sh1.Range("A" & Rows.Count).End(xlUp).Row).Value
 
  'load data from sheet2 (column A) into array ary2
  ary2 = sh2.Range("A2:A" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Value
 
  'To store the result, number of rows of the ary1 array with 2 columns
  ReDim ary3(1 To UBound(ary1), 1 To 5)
    
  k = 1
  'Go through the array ary2, Remember, array ary2 contains column A of sheet2
  For i = 1 To UBound(ary2, 1)
    'search in column A of sheet1 (that is, in the ary1 column 1)
    For j = 1 To UBound(ary1, 1)
      If ary2(i, 1) = ary1(j, 1) Then
        ary3(k, 1) = i          'store item number of ary2
        ary3(k, 2) = j          'store item number of ary1
        ary3(k, 3) = ary1(j, 1) 'store ID
        ary3(k, 4) = ary1(j, 2) 'store column B
        ary3(k, 5) = ary1(j, 3) 'store column C
        k = k + 1
      End If
    Next
  Next
  '
  'What to do with the result?
  Sheets("Sheet3").Range("A1").Resize(k - 1, 5).Value = ary3
End Sub

 

[tomleitch]

Thanks for your help with this Dante Amor, really appreciate it and sorry if I'm not explaining very well!

So what it needs to do is for each item from column A (Sheet 1) check if it is sheet 2 column a and then update cells offset (i call them pernumone, pernumto and pernumthr) of that, depending on what the cells themselves contain with column B (from sheet 1)...

Firstly it checks if Number is in either of the 3 offset cells pernumone, pernumto and pernumthr... if it is then it ignores it as it is already captured

Then if the offset cell on the row pernumone is empty or contains N/A then it writes the number into it and turns the cell yellow. If it already has a different number it looks to pernumtwo and then pernumthr.

If it has found over per numbers associated with that activity then it throws up a message box to tell you.

Then it basically does the same with columns referred to as idpnumone and idpnumtwo with the C column value.


Here is the old code that I was using to do this:

  If .exists(cl.Value) Then
                   
                   
                   If .Item(cl.Value)(0) = Cells(cl.Row, Pernumone).Value Or .Item(cl.Value)(0) = Cells(cl.Row, Pernumtwo).Value Or .Item(cl.Value)(0) = Cells(cl.Row, Pernumthr).Value Or .Item(cl.Value)(0) = "" Then GoTo 75
                   
                 

                    If Cells(cl.Row, Pernumone) = "" Or Cells(cl.Row, Pernumone) = "N/A" Then
                   Cells(cl.Row, Pernumone).Value = .Item(cl.Value)(0)
                   Cells(cl.Row, Pernumone).Interior.Color = rgbYellow
                    GoTo 75
                   End If
                If Cells(cl.Row, Pernumtwo) = "" Or Cells(cl.Row, Pernumtwo) = "N/A" Then
                  Cells(cl.Row, Pernumtwo).Value = .Item(cl.Value)(0)
                   Cells(cl.Row, Pernumtwo).Interior.Color = rgbYellow
                   GoTo 75
                 End If
                If Cells(cl.Row, Pernumthr) = "" Or Cells(cl.Row, Pernumthr) = "N/A" Then
                   Cells(cl.Row, Pernumthr).Value = .Item(cl.Value)(0)
                   Cells(cl.Row, Pernumthr).Interior.Color = rgbYellow
                 GoTo 75
                End If
               
                If .Item(cl.Value)(0) <> 0 Then MsgBox "Over 3 permits for activity: " & cl.Value & vbNewLine & vbNewLine & "Additional permits not recorded."


75             If .Item(cl.Value)(1) = Cells(cl.Row, IDPNUMONE).Value Or .Item(cl.Value)(1) = Cells(cl.Row, IDPNUMTWO).Value Or .Item(cl.Value)(1) = "" Then GoTo 76

                If Cells(cl.Row, IDPNUMONE) = "" Or Cells(cl.Row, IDPNUMONE) = "N/A" Then
                   Cells(cl.Row, IDPNUMONE).Value = .Item(cl.Value)(1)
                   Cells(cl.Row, IDPNUMONE).Interior.Color = rgbYellow
                    GoTo 76
                   End If
                If Cells(cl.Row, IDPNUMTWO) = "" Or Cells(cl.Row, IDPNUMTWO) = "N/A" Then
                   Cells(cl.Row, IDPNUMTWO).Value = .Item(cl.Value)(1)
                   Cells(cl.Row, IDPNUMTWO).Interior.Color = rgbYellow
                   GoTo 76
                 End If

etc....

 

[DanteAmor]

So it already works?
If it doesn't work for you, then you should forget the code, and explain with 3 or 4 examples what you want as a result and where you want it.

You only need a third image, with the expected result.

You already put the sheet1, you already put the sheet2,

now just put a third image with the result of the examples you put in the previous image.
And explain how you get to that result.

 

[tomleitch]

Hope this one explains a bit better

 

[DanteAmor]

The image is very small, I can not see.

Upload a file to the new.
It is important that you put the expected result and brief explanations of how to arrive at that result.

You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[tomleitch]

I have put the file to share in my onedrive, here is a link

Image link

 

[DanteAmor]

Try this, The results on sheets 3 and 4.

I did not put the numbers that are not stored in an msgbox, I better put them on the sheet4.

Run this macro: Search_Items

Dim m As Long 'global variable at the beginning of the entire code

Sub Search_Items()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim ary1 As Variant, ary2 As Variant, ary3 As Variant
  Dim i As Long, j As Long
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
 
  'load data from sheet1 (columns A-C) into array ary1
  ary1 = sh1.Range("A2:C" & sh1.Range("A" & Rows.Count).End(xlUp).Row).Value
  'load data from sheet2 (columns A-T) into array ary2
  ary2 = sh2.Range("A2:T" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Value
  'To store numbers without cell available
  ReDim ary3(1 To UBound(ary1), 1 To 3)
    
  m = 1
  'Go through the array ary2, Remember, array ary2 contains column A of sheet2
  For i = 1 To UBound(ary2, 1)
    'search in column A of sheet1 (that is, in the ary1 column 1)
    For j = 1 To UBound(ary1, 1)
      If ary2(i, 1) = ary1(j, 1) Then
        'search available cell to Number
        Call cell_available(ary1, ary2, ary3, j, i, m, 2, 18, 20)
        'search available cell to 2nd Number
        Call cell_available(ary1, ary2, ary3, j, i, m, 3, 16, 17)
      End If
    Next
  Next
  '
  'Result of sheet2 on sheet3
  Sheets("Sheet3").Cells.ClearContents
  Sheets("Sheet3").Range("A2").Resize(UBound(ary2), 20).Value = ary2
  '
  'number and 2nd number not stored because there were no cells available
  Sheets("Sheet4").Cells.ClearContents
  Sheets("Sheet4").Range("A2").Resize(m, 3).Value = ary3
  '
  MsgBox "Done"
End Sub

Sub cell_available(ary1, ary2, ary3, j, i, m, n, k1, k2)
  Dim ava As Long, exists As Boolean, k As Long
  exists = False
  ava = 0
  If ary1(j, n) <> "" Then
    For k = k1 To k2
      If ary2(i, k) = "" Or ary2(i, k) = "N/A" Then
        If ava = 0 Then ava = k
      End If
      If ary2(i, k) = ary1(j, n) Then exists = True
    Next
    If exists = False Then
      If ava = 0 Then 'Not available cell for Number
        ary3(m, 1) = ary1(j, 1) 'store ID
        ary3(m, 2) = ary1(j, n) 'store number
        m = m + 1
      Else
        ary2(i, ava) = ary1(j, n)
      End If
    End If
  End If
End Sub

 

[tomleitch]

Thanks very much - I will have a go with that