VBA Help. Unable to Define WB1 and WB2

[joanna_sjw]

Hello, I'm just a 2 days into VBA with alot of help from various online sources.
I am trying to automate a reporting whereby:
1) Downloads a data file from a web browser
2) Save this file in a location
3) Opens the downloaded file and do data cleaning (unmerge cells and delete blank rows)
4) Copy data from cleaned data till last row and paste to main compiled data from last empty row onwards
5) Fill dates in column A based on a value from main compiled data file till last available data row

Currently I am stuck at 4 where WB1 and WB2 does not seem to be able to be defined.. it is returning me nothing for both. Hence I can't get the lastrow defined as well.
Checked fname with debug.print and the directory was ok. Can anyone help to see what's wrong?
Any help is appreciated!

Sub AutomateAccessReport()
    Dim i As Long
    Dim FileNum As Long
    Dim FileData() As Byte
    Dim MyFile As String
    Dim WHTTP As Object
    
    On Error Resume Next
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
        If Err.Number <> 0 Then
            Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
        End If
    On Error GoTo 0
    
    'create download folder
    If Dir("C:\Users\X\Desktop\RPA\Access", vbDirectory) = Empty Then MkDir "C:\Users\X\Desktop\RPA\Access"
    
    'loop row 1 to 1
    For i = 1 To 1
        MyFile = Cells(i, 1)
        
        WHTTP.Open "GET", MyFile, False
        WHTTP.Send
        FileData = WHTTP.ResponseBody
    
    'putting the downloaded file into the directory
        FileNum = FreeFile
                Open "C:\Users\X\Desktop\RPA\Access\" & Cells(i, 3) For Binary Access Write As #FileNum
                    Put #FileNum, 1, FileData
        Close #FileNum
    Next
    Set WHTTP = Nothing
MsgBox ("Download completed")

'Open a workbook
'Open method requires full file path to be referenced.
  
Const fpath As String = "C:\Users\X\Desktop\RPA\Access\" ' your fixed folder
Dim fname As String

' Below defines fname
fname = Format(Workbooks("RPA USS.xlsm").Worksheets("RPA").Range("B1").Value, "YYYY-MM-DD")
fname = fname & "_RPT_Access_Report_By_Operation.xls"
fname = fpath & fname

Dim wb As Workbook
Set wb = Workbooks.Open(fname)
If wb Is Nothing Then MsgBox "File does not exist":

Debug.Print (fname)

'Unmerge All Cells
ActiveSheet.Cells.UnMerge

'Delete Empty Rows
On Error Resume Next
Columns("N").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

MsgBox ("Data Cleaning Completed")

'Copy Data Range till last available data row from WB1 and paste to WB2 from last data row onwards
Dim WB1 As Worksheet
Dim WB2 As Worksheet
Set WB1 = Workbooks(fname).Worksheets("Sheet1")
Set WB2 = Workbooks("RPA USS.xlsm").Worksheets("DATA")
Dim lastrow As String
Dim lastrow2 As String

With WB1
lastrow = WB1.Range("A" & .Rows.Count).End(xlUp).Row
lastrow2 = WB2.Range("A" & .Rows.Count).End(xlUp).Offset(1).Row

End With
WB1.Range("A2:O" & lastrow).Copy WB2.Range ("B" & lastrow2)

'Fill Dates
Workbooks("RPA USS.xlsm").Worksheets("RPA").Range("B1").Value.Copy
WB2.Range("A" & lastrow2).Paste

End Sub

 

[GWteB]

I've not tested it, but for a start change these lines
'Copy Data Range till last available data row from WB1 and paste to WB2 from last data row onwards Dim WB1 As Worksheet Dim WB2 As Worksheet Set WB1 = Workbooks(fname).Worksheets("Sheet1") Set WB2 = Workbooks("RPA USS.xlsm").Worksheets("DATA") Dim lastrow As String Dim lastrow2 As String
into this

    Dim WB1 As Worksheet
    Dim WB2 As Worksheet
    Set WB1 = wb.Worksheets("Sheet1")
    Set WB2 = wb.Worksheets("DATA")
    Dim lastrow As Long
    Dim lastrow2 As Long

 

[joanna_sjw]

Thanks!

WB1 works now. But WB2 still doesnt.
I think it's because it's supposed to refer to a 2nd workbook, not the same one.

Or should I do another dim for the 2nd workbook as the same as wb?

    Dim WB1 As Worksheet
    Dim WB2 As Worksheet
    Set WB1 = wb.Worksheets("Sheet1")
    Set WB2 = wb.Worksheets("DATA")
    Dim lastrow As Long
    Dim lastrow2 As Long

 

[GWteB]

Okay, let me take a more thorough look ...

 

[GWteB]

Made a small overhaul based on your original code. Still not able to test it, see if it works for you.

Sub AutomateAccessReport()

    Const cDownLoadFolder   As String = "C:\Users\X\Desktop\RPA\Access"
    Dim i                   As Long
    Dim FileNum             As Long
    Dim FileData()          As Byte
    Dim MyFile              As String
    Dim WHTTP               As Object
    Dim fName               As String
    Dim fNameDate           As Variant
    Dim oWb                 As Workbook
    Dim oWs1                As Worksheet
    Dim oWs2                As Worksheet
    Dim lastrow             As String
    Dim lastrow2            As String
  
    On Error Resume Next
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
        If Err.Number <> 0 Then
            Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
        End If
    On Error GoTo 0
  
    'create download folder
    If Dir(cDownLoadFolder, vbDirectory) = Empty Then MkDir cDownLoadFolder
  
    'loop row 1 to 1
    For i = 1 To 1
        MyFile = Cells(i, 1)
      
        WHTTP.Open "GET", MyFile, False
        WHTTP.Send
        FileData = WHTTP.ResponseBody
  
        'putting the downloaded file into the directory
        FileNum = FreeFile
        Open cDownLoadFolder & "\" & Cells(i, 3) For Binary Access Write As #FileNum
        Put #FileNum, 1, FileData
        Close #FileNum
    Next
    Set WHTTP = Nothing
    MsgBox ("Download completed")
  
  
    'Open a workbook
    'Open method requires full file path to be referenced.
    ' Below defines fname
    fNameDate = Workbooks("RPA USS.xlsm").Worksheets("RPA").Range("B1").Value
  
    fName = Format(fNameDate, "YYYY-MM-DD")
    fName = fName & "_RPT_Access_Report_By_Operation.xls"
    fName = cDownLoadFolder & "\" & fName
  
    Set oWb = Workbooks.Open(fName)
    If oWb Is Nothing Then
        MsgBox "File does not exist":
        ' nothing to do so ...
        GoTo SUB_EXIT
    End If
    Debug.Print (fName)
  
    'Unmerge All Cells
    ActiveSheet.Cells.UnMerge
  
    'Delete Empty Rows
    On Error Resume Next
    Columns("N").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
  
    MsgBox ("Data Cleaning Completed")
  
    'Copy Data Range till last available data row from WB1 and paste to WB2 from last data row onwards
    Set oWs1 = oWb.Worksheets("Sheet1")
    Set oWs2 = Workbooks("RPA USS.xlsm").Worksheets("DATA")
  
    With oWs1
        lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
        lastrow2 = oWs2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("A2:O" & lastrow).Copy WB2.Range("B" & lastrow2)
    End With
  
    'Fill Dates
    oWs2.Range("A" & lastrow2).Value = fNameDate
  
SUB_EXIT:
End Sub

EDIT:
If your code is in the "RPA USS.xlsm" file you could replace Workbooks("RPA USS.xlsm") by ThisWorkbook in your code.

 

[joanna_sjw]

Wow thanks! Looks so much cleaner now.
And yes, RPA USS.xlsm is the workbook I am writing the code in. I have replaced them with ThisWorkbook.

Everything works till the copying part.
The pasting still does not seem to work... it seemed like it is not reading the correct sheet somehow even though we have inputted it as "DATA" below.
lastrow2 is returning me a value of 2 but it should be 392177.

I tried splitting the copy and paste function. Still reverts the same thing.
Or I have to activate the tab to "DATA" for it to work? Any idea?

    Set oWs1 = oWb.Worksheets("Sheet1")
    Set oWs2 = ThisWorkbook.Worksheets("DATA")
  
    With oWs1
        lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A2:O" & lastrow).Copy
    End With
  
    With oWs2
        lastrow2 = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        .Range("B" & lastrow2).Paste
    End With

 

[joanna_sjw]

Managed to solve with the below!
Thanks so much for your help.

    Set oWs1 = oWb.Worksheets("Sheet1")
    Set oWs2 = ThisWorkbook.Worksheets("DATA")
  
    With oWs1
        lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
        
    End With
  
    With oWs2
        .Activate
        lastrow2 = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        oWs1.Range("A2:O" & lastrow).Copy .Range("B" & lastrow2)
    End With

 

[GWteB]

Activation of a tab is not necessary. Since you're splitting up the copy/paste function the intended reference to the right worksheet was gone (intended since I made a typo in my post #5 code ).
WB2 should have been oWs2

 

[GWteB]

Managed to solve with the below!
Thanks so much for your help.

You're welcome and thanks for letting me know.