Excel Dictionary - copy from sheet 1 to sheet 2

[Celticfc]

Hi all,

I have a client comments in sheet Client Comments that I would like to paste to sheet All Comments. Client ID's are in Column AV and comments in Column CE in both sheets. The code below takes 13 minutes and doesn't paste any comments so would appreciate any support.

In Phase 1, I'm building the dictionary (here, I need a code to only build dictionary for rows AV2: AV150).

In Phase 2, I'm comparing Client ID's with the master sheet (all comments) that has 5000 Clients and pasting their values.

  Dim dict As New Scripting.Dictionary
  Dim myRow As Range
  Dim mySheet As Worksheet

  Const RefSheetName As String = "client comments"
  
  Set mySheet = ThisWorkbook.Worksheets(RefSheetName)
  For Each myRow In mySheet.Range(mySheet.Range("Av1").End(xlDown), mySheet.Range("Av" & mySheet.Rows.Count).End(xlUp))

    dict.Add myRow.Value, myRow.Offset(0, 38).Value
  Next myRow

      For Each myRow In Workbooks("e127.xlsb").Worksheets("all comments").Range("av1:av5000")
     
        If dict.exists(myRow.Value) Then

          myRow.Offset(0, 38).Value = dict(myRow.Value)
         End If
      Next myRow

 

[Dryver14]

Thanks for posting this, I have never had reason to look at Scripting Dictionaries before...something to explore.

That said, the problem seems easily resolvable with a vlookup in column 38 of the second workbook.

This is my suggestion for fixing the pasting issue, I am not sure on the runtime issue at all. Also do you really want to be pasting myrow.value I would have thought myrow.offset(0,38).value but I may be reading it wrong


I think I would dim Cell as range as well then change

For Each myRow In Workbooks("e127.xlsb").Worksheets("all comments").Range("av1:av5000")

If dict.exists(myRow.Value) Then

myRow.Offset(0, 38).Value = dict(myRow.Value)
End If
Next myRow

for


Workbooks("e127.xlsb").Worksheets("all comments").Range("av1:av5000").Select

For Each cell In Selection
If dict.Exists(myRow.Value) Then
myRow.Offset(0, 38).Value = dict(myRow.Value)
End If
Next cell

 

[Fluff]

Try changing your offset to 35 instead of 38

 

[Fluff]

If you want to hard code the ranges try

Sub Comparecomments()

   Dim Cl As Range
   Dim SrcWs As Worksheet
   Dim Destws As Worksheet

Application.ScreenUpdating = False

   Set SrcWs = ThisWorkbook.Sheets("client comments")
   Set Destws = Workbooks("e127.xlsb").Worksheets("all comments")

   With CreateObject("scripting.dictionary")
      For Each Cl In SrcWs.Range("AV2:AV150")
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 35).Value
      Next Cl
      For Each Cl In Destws.Range("AV1:AV5000")
         If .exists(Cl.Value) Then Cl.Offset(, 35).Value = .Item(Cl.Value)
      Next Cl
   End With
         
End Sub