VBA code to copy and paste raw data into different workbook

[waptrick]

I have written some vba code that copies and pastes raw data into another workbook.

It does so by looping through the sheets identified in the “Sub Act() section” and call the updatesheet function in each sheet to identify the place to copy paste raw data in and then to copy formulas in column I in the row immediately before the starting row of the raw data.

Such starting row is identified by frow = ReturnfirstDrow(shtname) + 1.

The code then goes into the raw data.xlsx to select and copy the raw data into the cell located at column B.

The problem I am having is that the vba code seems to be removing rows in the workbook it is copying the raw data into. It should copy the new data and paste over the old values corresponding to the dates and then add the new data.

Can anyone help with this?

Function FindFirstFormulaRow(ByRef rng As Range) As Long

    Dim arrFormulas As Variant

        Set arrFormulas = rng.SpecialCells(xlCellTypeFormulas)
        Set rng = arrFormulas

            If Not rng Is Nothing Then
                FindFirstFormulaRow = Split(rng.Cells(1).Address, "$")(2)
                Set rng = rng.Cells(1)
            End If
End Function

Function ReturnfirstDrow(ByVal shtname As String) As Long
    Dim row, count, judge As Integer
    Workbooks.Open Filename:="H:\Travel and Leisure\General sector\Sector book\Spreadsheets\Redburn Demand Indicator (RDI).xlsx"
    Workbooks("Redburn Demand Indicator (RDI).xlsx").Activate
    judge = 0
    count = 20
    While judge = 0
        If Len(Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Cells(count, 4).Value) > 0 Then
            judge = 1
            ReturnfirstDrow = count
        End If
        count = count + 1
    Wend
End Function

Sub updateRDIsheet(ByVal shtname, shtname2 As String)
'''Sub updateRDIsheet()
Dim rownum, colnum, lastDrow, frow, lastLrow, lastcol, lastrawrow, lastrawcol As Integer
Dim formulaRng As Range
'Dim shtname, shtname2 As String
   
    Workbooks.Open Filename:="H:\Travel and Leisure\General sector\Sector book\Spreadsheets\Redburn Demand Indicator (RDI).xlsx", UpdateLinks:=False
    Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Activate
    lastLrow = FindFirstFormulaRow(Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Range("L:L"))
    Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Cells(lastLrow, 12).Copy
    Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Cells(lastLrow, 12).PasteSpecial Paste:=xlPasteValues
    frow = ReturnfirstDrow(shtname) + 1
    Workbooks.Open Filename:="H:\Travel and Leisure\General sector\Sector book\Spreadsheets\RDI raw data.xlsx"
    Workbooks("RDI raw data.xlsx").Sheets(shtname2).Activate
    lastrawrow = Workbooks("RDI raw data.xlsx").Sheets(shtname2).Range("B" & Rows.count).End(xlUp).row
    lastrawcol = Workbooks("RDI raw data.xlsx").Sheets(shtname2).Range("B3").SpecialCells(xlCellTypeLastCell).Column
    If Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Range("C" & frow - 1).Value = Workbooks("RDI raw data.xlsx").Sheets(shtname2).Cells(3, 2).Value Then
        MsgBox ("No update necessary for " & shtname)
      
    Else
        If Workbooks("RDI raw data.xlsx").Sheets(shtname2).Cells(lastrawrow, lastrawcol).Value = "False" Then
            Workbooks("RDI raw data.xlsx").Sheets(shtname2).Range(Cells(3, 2), Cells(lastrawrow, lastrawcol - 1)).Select
        Else
            Workbooks("RDI raw data.xlsx").Sheets(shtname2).Range(Cells(3, 2), Cells(lastrawrow - 1, lastrawcol - 1)).Select
        End If
        Selection.Copy
        Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Activate
        Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Range("C" & frow).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Range("D" & (frow - 1) & ":H" & (frow - 1)).ClearContents
        Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Range("I" & (frow - 2)).Select
        Selection.Copy
        Workbooks("Redburn Demand Indicator (RDI).xlsx").Sheets(shtname).Range("I" & (frow - 1)).Select
        Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
    End If
End Sub

 

[waptrick]

I should add that the data is from google trends and I am downloading 5 years worth of search interest for specific keywords. The data series is dynamic and updates the entire series not just the new weekly data points.