CODEWITHSUNDEEP
vbaexcel
nabilah
nabilah

Reputation: 211

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

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. enter image description here

Upvotes: 5

Views: 135

Answers (1)

paul bica
paul bica

Reputation: 10715

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

Upvotes: 2

Related Questions