Copy and paste information based on matching identifiers, where one sheet has rows in the pivot table

Question

I have code that allows me to copy and paste thousands of lines of information based on matching identifiers. However, the code does not seem to work well in the pivot table. On sheet 4, the identifiers are placed in the pivot table, and in sheet 1 - identifiers, and the information is not in the pivot table (both identifiers on sheet 4 and 1 are in the same column, which is column A). However, the identifiers appeared more than once in sheet 1. Thus, when I try to run the code, it gives the error below Cannot enter a null value as an item or field name in pivot table report" on the line 'rngTracker.Value = arrT .

 Sub Sample() Dim rngTracker As Range Dim rngMaster As Range Dim arrT, arrM Dim dict As Object, r As Long, tmp With Workbooks("FAST_Aug2015_Segment_Out_V1.xlsm") Set rngTracker = .Sheets("Sheet4").Range("A5:D43000") Set rngMaster = .Sheets("Sheet1").Range("A2:C200000") End With 'get values in arrays arrT = rngTracker.Value arrM = rngMaster.Value 'load the dictionary Set dict = CreateObject("scripting.dictionary") For r = 1 To UBound(arrT, 1) dict(arrT(r, 1)) = r Next r 'map between the two arrays using the dictionary For r = 1 To UBound(arrM, 1) tmp = arrM(r, 1) If dict.exists(tmp) Then arrT(dict(tmp), 4) = arrM(r, 3) End If Next r rngTracker.Value = arrT 'Error shown on this line' End Sub 

Above is the code that I have and gave an error, as mentioned above. Would thank for any help. Thank you. :) The image of the pivot table in sheet 4 is shown below. The column heading, called "Acc Seg", is not part of the pivot table, but that is where the data will be inserted from sheet 1 when both identifiers in sheet 4 and sheet 1 match.

Answer 1

 Option Explicit Public Sub Sample() Const T As Long = 43000 Const M As Long = 200000 Dim arrT1 As Variant, arrM1 As Variant, rngT2 As Range Dim arrT2 As Variant, arrM2 As Variant, dict As Object, r As Long With Workbooks("TEST2.xlsm") 'get values in arrays Set rngT2 = .Sheets("Sheet4").Range("D5:D" & T) arrM1 = .Sheets("Sheet1").Range("A2:A" & M) arrM2 = .Sheets("Sheet1").Range("C2:C" & M) arrT1 = .Sheets("Sheet4").Range("A5:A" & T) arrT2 = rngT2 End With Set dict = CreateObject("Scripting.Dictionary") For r = 1 To UBound(arrT1) 'load the dictionary dict(arrT1(r, 1)) = r Next r For r = 1 To UBound(arrM1, 1) 'map between the arrays using the dictionary If dict.exists(arrM1(r, 1)) Then arrT2(dict(arrM1(r, 1)), 1) = arrM2(r, 1) Next r rngT2 = arrT2 End Sub