Extract data using Scripting Dictionary

abc_xyz

New Member
Joined
Jan 12, 2022
Messages
47
Office Version
  1. 2016
Platform
  1. Windows
I am trying to extract data from Source file and paste it into their respective template file.

Column EColumn F
CountryFile path
BrazilC:\Users\ABC123\Desktop\Brazil.xlsx
USAC:\Users\ABC123\Desktop\USA.xlsx

Requirement: Copy rows from the source file which has the same country from Column E and paste the entire row in the file path provided in the next cell.

The code seems to paste entire data set for the listed countries. It should paste Brazil's data into brazils file and so on. Can someone please help?

Also asked here Copy data from Master File and Paste to their Respective file

VBA Code:
Sub test1()


Dim SourceFilePath, SourceSheet, CountryName, DestinationFilePath, NewSheetName, File_Name As String
Dim OpenSource, OpenDestination As Workbook
Dim cl As Range, Rng As Range
Dim Dic As Object
Dim StartTime As Double
Dim MinutesElapsed As String
Dim i, lastrow As Long




With Application
   .ScreenUpdating = True
   .DisplayAlerts = False
   .EnableEvents = False
End With



lastrow = ThisWorkbook.Sheets("Dashboard").Range("E" & Rows.Count).End(xlUp).Row
SourceFilePath = ThisWorkbook.Sheets("Dashboard").Range("F3")
SourceSheet = ThisWorkbook.Sheets("Dashboard").Range("G3")


Set Dic = CreateObject("scripting.dictionary")
   
'Add Key words to dictionary
    With ThisWorkbook.Sheets("Dashboard")
  
        For Each cl In .Range("E12", .Range("E" & Rows.Count).End(xlUp))
           
            Dic(cl.Value) = cl.Value
       
        Next cl
       
    End With




Set OpenSource = Workbooks.Open(SourceFilePath)




'Loop through each Key in the Dictionary
For Each Key In Dic.keys

    For i = 12 To lastrow


DestinationFilePath = ThisWorkbook.Sheets("Dashboard").Cells(i, 6)
NewSheetName = ThisWorkbook.Sheets("Dashboard").Cells(i, 7)
File_Name = ThisWorkbook.Sheets("Dashboard").Cells(i, 8)

Set OpenDestination = Workbooks.Open(DestinationFilePath)

        With OpenSource.Sheets(SourceSheet)

                For Each cl In .Range("V2", .Range("V" & Rows.Count).End(xlUp))
           
                    If Dic.Exists(cl.Value) Then
                        If Rng Is Nothing Then Set Rng = cl Else Set Rng = Union(Rng, cl)
                    End If
       
                Next cl
           
                    If Not Rng Is Nothing Then Rng.EntireRow.Copy

        End With


        With OpenDestination.Sheets(SourceSheet)
            .Range("A2").PasteSpecial Paste:=xlPasteValues
        End With


    Next i

Next Key





With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
End With




End Sub
 
Well my comments on the last code apply here too, but now I'm even more confused - What is this storing in the dictionary?

VBA Code:
Dict(cl.Value) = cl.Offset(, 1).Value

This is teh code you had on the other website, no?
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,624
Latest member
gregg777

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top