Copy code does not copy

[Rip1971]

Hi there,

i have a piece of code that somehow does not do what i would like. it does not give any errors maybe someone can point me in the right direction it would be appreciated.

Sub CopyCat()
   ' deze wordt gebruikt voor het kopieren van category tov ordernr
   
   Application.ScreenUpdating = False
   Dim LastRow As Long, r As Long
   Dim srcWS As Worksheet, desWS As Worksheet
   Dim Ary As Variant, Nary As Variant
   Dim Wbk As Workbook
   
   Set desWS = ActiveWorkbook.Sheets("TA Inventory")
   
' het openen van de benodigde file voor invoeren data
   On Error Resume Next
   Set Wbk = Workbooks.Open("Source.xlsx")
   On Error GoTo 0
   If Wbk Is Nothing Then
      Fname = Application.GetOpenFilename
      If Fname = "False" Then Exit Sub
      Set Wbk = Workbooks.Open(Fname)
   End If
   
   
   Set srcWS = Wbk.Sheets("Rip")
   With srcWS
      LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Ary = .Range("A2:F" & LastRow).Value2
   End With
   With CreateObject("scripting.dictionary")
' Deze waarden aanpassen om de juiste kolom te controleren ".Item(Ary(r, 2)) = Ary(r, 1)"
' A=1, B=2, C=3, D=4, E=5, F=6
      For r = 1 To UBound(Ary)
         .Item(Ary(r, 1)) = Ary(r, 2)
      Next r
      LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' Lokatie invullen van kolom waarmee vergelijken moet worden
      Ary = desWS.Range("A4:A" & LastRow).Value2
' Lokatie invullen van kolom waar data naar toe moet
      Nary = desWS.Range("AO4:AO" & LastRow).Value2
      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))
      Next r
   End With
' lokatie invullen waar dat moet beginnen
   desWS.Range("AO4").Resize(UBound(Nary)).Value = Nary
   
' sluiten van bron bestand
'    Wbk.Close Savechanges:=False
    
   Application.ScreenUpdating = True
End Sub

 

[offthelip]

to help you debug the problewn I suggest changing this code:

      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))
      Next r

to

      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then
         Nary(r, 1) = .Item(Ary(r, 1))
         Else
         Nary(r, 1) = Ary(r, 1) & "Not Found"
         End If
      Next r

You may want to consider keeping the "Not found " text

 

[Rip1971]

to help you debug the problewn I suggest changing this code:

      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))
      Next r

to

      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then
         Nary(r, 1) = .Item(Ary(r, 1))
         Else
         Nary(r, 1) = Ary(r, 1) & "Not Found"
         End If
      Next r

You may want to consider keeping the "Not found " text

after adding the debug code. allof the orders are filled in with 'not found' added. The data in column B (2) is not added.

 

[offthelip]

I have just tested your code from the line :

Set srcWS = Wbk.Sheets("Rip")

Onwards and it all works fine. So this means that either you are not opening the file correctly or the data in column A of the RIP worksheet doesn't match the data in column A fo the TA Inventory worksheet.
Firstly I suggest you don't reuse the Ary array but create a second array where you load the data from desWS worksheet, then compare these two arrays in the locals window:
so change these lines:

      Ary = desWS.Range("A4:A" & LastRow).Value2
' Lokatie invullen van kolom waar data naar toe moet
      Nary = desWS.Range("AO4:AO" & LastRow).Value2
      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))

to

      Ary2 = desWS.Range("A4:A" & LastRow).Value2
' Lokatie invullen van kolom waar data naar toe moet
      Nary = desWS.Range("AO4:AO" & LastRow).Value2
      For r = 1 To UBound(Ary2)
         If .Exists(Ary2(r, 1)) Then Nary(r, 1) = .Item(Ary2(r, 1))

then put a breakpoint on this line:

For r = 1 To UBound(Ary)

and then look in the locals window and compare what you have got in Ary and Ary2 , look in particular for the length of the strings ( are there any extra spaces??) The first element in the two arrays should be a match somewhere, but obviously this is not happening

 

[Rip1971]

I have just tested your code from the line :

Set srcWS = Wbk.Sheets("Rip")

Onwards and it all works fine. So this means that either you are not opening the file correctly or the data in column A of the RIP worksheet doesn't match the data in column A fo the TA Inventory worksheet.
Firstly I suggest you don't reuse the Ary array but create a second array where you load the data from desWS worksheet, then compare these two arrays in the locals window:
so change these lines:

      Ary = desWS.Range("A4:A" & LastRow).Value2
' Lokatie invullen van kolom waar data naar toe moet
      Nary = desWS.Range("AO4:AO" & LastRow).Value2
      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))

to

      Ary2 = desWS.Range("A4:A" & LastRow).Value2
' Lokatie invullen van kolom waar data naar toe moet
      Nary = desWS.Range("AO4:AO" & LastRow).Value2
      For r = 1 To UBound(Ary2)
         If .Exists(Ary2(r, 1)) Then Nary(r, 1) = .Item(Ary2(r, 1))

then put a breakpoint on this line:

For r = 1 To UBound(Ary)

and then look in the locals window and compare what you have got in Ary and Ary2 , look in particular for the length of the strings ( are there any extra spaces??) The first element in the two arrays should be a match somewhere, but obviously this is not happening

i have had issues with values not being converted to numbers and this has solved my issue. thanks for the help all.

 

[offthelip]

Glad to have helped