I have a code that allows me to copy and paste thousands of rows of information based on matching IDs. However the code does not seem to run well in a pivot table. In sheet 4, the IDs are put into a pivot table while in sheet 1 the IDs and the information are not in pivot table (Both IDs in sheet 4 and 1 are in the same column which is column A). However, the IDs appeared more than once in sheet 1. Thus, when i try to run the code, it gave an error that said Cannot enter a null value as an item or field name in pivot table report" on the line 'rngTracker.Value = arrT
found below.
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 error as mention above. Would appreciate any help. Thank you. :) Below is the image of the pivot table in sheet 4. The column header called "Acc Seg" is not part of the pivot table but it is where the data will be paste from sheet 1 when both IDs in sheet 4 and sheet 1 matched.
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With