Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

excel

vba

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

like image 492
nabilah Avatar asked Oct 31 '22 19:10

nabilah


1 Answers

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
like image 124
paul bica Avatar answered Nov 15 '22 06:11

paul bica