VBA Macro wanted - Loop copying data from one sheet to another

Question

Last year, I made a huge spreadsheet with all newest available data on every country in the world. The idea was that I could download the latest data - say, a data sheet containing population statistics from the World Bank - and easily transport them into my main sheet.

Here is an example of how it looked like:

To draw the data from the other spreadsheets, I used long, messy lines of IF-functions, such as:

=IF(ISNUMBER(IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;2;FALSE);"Not 
Found"));IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;2;FALSE);"Not 
Found");"Not Found")&" 
("&IF(ISNUMBER(IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;3;FALSE);"Not 
Found"));IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;3;FALSE);"Not 
Found");"Not Found")&")"

Obviously, this is not the most efficient way of doing this. Here is what I need the macro to do:

1. To first match column A, containing all country names, in my main sheet, with column A in the data sheet, containing countries specific to this data set.
2. Then copy-paste the latest data (non-blank cell furthest to the right) from the data sheet into the main sheet, at the appropriate places (i.e. Uganda gets matched with Uganda).
3. The pasted data must also contain their respective years in parenthesis (in the picture, all data happen to be from 2016, but this is not always the case).

I have experimented with some loops to try and replicate the above-mentioned IF-functions, but nothing seems to work for me. So far, my tries have led me to this:

Option Explicit

Sub test()

Dim data As Worksheet
Dim report As Worksheet
Dim finalrow As Integer
Dim finalcol As Integer
Dim rngMatch As Range
Dim i As Integer
Dim countryname As String

Set data = Ark2
Set report = Ark1

countryname = data.Range("A5").Value

report.Range("B2:CC300").ClearContents

data.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To finalrow
    If Cells(i, 1) = countryname Then
    Cells(i, 5).Copy
    report.Select
    Range("B300").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    data.Select
    End If

Next i

report.Select

End Sub

There are many flaws here, and it does not come close to solve my problem. Can anyone perhaps point me in the right direction of what to do?

Thank you for your time.

Answer 1

EDIT - As JvdV pointed out, copy pasting is not really necessary, so I changed the code to report.Sheets[...].Value = data.Sheets[...].Value instead, which is much, much faster. Thank you again, JvdV.

---

So, with the help of JvdV, I was able to piece together a macro, which works just fine for me.

Sub extract()

Dim RNG1 As Range, CL1 As Range
Dim LR1 As Long, LR2 As Long, LC As Long

Set report = Workbooks("Main.xlsm")
Set data = Workbooks("API_NE.EXP.GNFS.CD_DS2_en_excel_v2_9944773.xls")

report.Sheets("Report").Activate
data.Sheets("Data").Activate

LR1 = report.Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Row
LR2 = data.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
RC2 = report.Sheets("Report").Cells(LR1, Columns.Count).End(xlToLeft).Column + 1
RC3 = RC2 + 1

Set RNG1 = data.Sheets("Data").Range(Cells(1, 1), Cells(LR2, 1))
report.Sheets("Report").Cells(1, RC2).Value = data.Sheets("Data").Cells(5, 3).Value
report.Sheets("Report").Cells(1, RC3).Value = "Year"

For X = 2 To LR1
    With RNG1
        Set CL1 = .Find(What:=report.Sheets("Report").Cells(X, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not CL1 Is Nothing Then
            LC1 = data.Sheets("Data").Cells(CL1.Row, Columns.Count).End(xlToLeft).Column
            If IsNumeric(data.Sheets("Data").Cells(CL1.Row, LC1)) Then
                report.Sheets("Report").Cells(LR1, RC2).End(xlUp).Offset(1, 0).Value = data.Sheets("Data").Cells(CL1.Row, LC1).Value
            Else
                report.Sheets("Report").Cells(LR1, RC2).End(xlUp).Offset(1, 0).Value = "N/A"
            End If

            If IsNumeric(data.Sheets("Data").Cells(CL1.Row, LC1)) Then
                report.Sheets("Report").Cells(LR1, RC3).End(xlUp).Offset(1, 0).Value = data.Sheets("Data").Cells(4, LC1).Value
            Else
                report.Sheets("Report").Cells(LR1, RC3).End(xlUp).Offset(1, 0).Value = "N/A"
            End If


        End If
    End With
Next X

report.Sheets("Report").Activate

With Worksheets("Report").Columns(RC2)
    .NumberFormat = "0.00"
    .Value = .Value
End With

With Worksheets("Report").Columns(RC3)
    .NumberFormat = "0"
    .Value = .Value
End With

End Sub

This macro allows you to extract latest data from a timeseries, as well as the respective year of the datapoint. In this specific macro you can duplicate data on any country, from any spreadsheet provided by the World Bank. All you have to do, is:

1. plug in the name of your workbook (eg. "Main.xlsm") as well as the name of the workbook from the World Bank (eg. "API_NE.EXP.GNFS.CD_DS2_en_excel_v2_9944773.xls")
2. Name the countries of your interest in Column A of your own workbook.
3. Let the macro run
4. Plug in a new workbook from the World Bank
5. Let the macro run again
6. etc.

The macro will not overwrite previous data, but rather duplicate the datapoints and sample years in the right-most columns. An example of the macro in action can be seen below.

Example of the macro

Answer 2

here is a loop that will:

• Loop through column A in your main workbook (country names)
• Will look up this country in your data workbook
• Gets the last used column of the found row (if value is found)

• Prints the value in the direct window, obviously you must adjust that piece of code

  Sub Test()
  
  Dim RNG1 As Range, CL1 As Range
  Dim LR1 As Long, LR2 As Long, LC As Long
  
  LR1 = Workbooks("MainWB").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
  LR2 = Workbooks("DataWB").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
  Workbooks("DataWB").Activate
  Set RNG1 = Workbooks("DataWB").Sheets(1).Range(Cells(1, 1), Cells(LR2, 1))
  
  For X = 3 To LR1
      With RNG1
          Set CL1 = .Find(What:=Workbooks("MainWB").Sheets(1).Cells(X, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
          If Not CL1 Is Nothing Then
              LC = Workbooks("DataWB").Sheets(1).Cells(CL1.Row, Columns.Count).End(xlToLeft) + 1
              Debug.Print Workbooks("DataWB").Sheets(1).Cells(CL1.Row, LC).Value 'Do something else with this value obviously
          End If
      End With
  Next X
  
  Workbooks("MainWB").activate
  End Sub
  

You obviously need to adjust all variables and names to your needs. Hopefully you will find bits and pieces usefull.