excelvbaexcel-4.0

Copy paste from closed workbook using VBA in Excel

I have 2 workbooks: "reportPageImpression.xlsx" and "testCloseWorkbook.xslx". Currently I am able to get data from reportPageImpression to testCloseWorkbook when clicking the "Update" button.

update button

What I try to do is when clicking again the "Update" button, the value will go to "Jan-16" (new column) and so on. Here's my code:

Option Explicit
Private Function GetValueFromClosedWorkbook(path, file, sheet, ref)
    Dim arg As String
    
    'Let’s check whether the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
        GetValueFromClosedWorkbook = "File Not Found"
        Exit Function
    End If
    
    'We create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
          Range(ref).Range("A1").Address(, , xlR1C1)
    
    'MsgBox arg
    'Now we execute an XLM macro
    'All references must be given as R1C1 strings.
    GetValueFromClosedWorkbook = ExecuteExcel4Macro(arg)

End Function

Sub TestGetValueFromClosedWorkbook()
    Dim p As String, f As String
    Dim s As String, a As String
    
    p = ThisWorkbook.path
    f = "reportPageImpression.xlsx"
    s = "report_page_impression"
    a = "D39"
         
    ActiveSheet.Range("C8") = GetValueFromClosedWorkbook(p, f, s, a)
     
End Sub
Solution 
  • ActiveSheet.Cells(Range("C8").Row, Columns.Count).End(xlToLeft).Offset(0, 1) = GetValueFromClosedWorkbook(p, f, s, a)

    to check for a cell to be empty you must use a formula like "COUNTA(range)" as the argument of the ExecuteExcel4Macro(arg) method and get back the number of non empty cells in the closed workbook specified range.

    If you specify your cell address as its range and it returns zero then that cell is empty otherwise it has a value and then you can use ExecuteExcel4Macro(arg) method again with the cell reference as its argument. In this latter case you may want to use .Offset(rowOffset) method on your original "Range" to shift to a cell rowOffset rows apart from it.

    In order not to get lost in references, I'd suggest you to refactor your code and make extensive use of "wrappers" in order to have clean an maintanable code

    Here you may find what I've come up to as per my understanding

    Sub TestGetValueFromClosedWorkbook()
Dim p As String, f As String
Dim s As String, a As String
Dim argPart As String

Dim var As Variant
Dim checkSheetResult As String

p = ThisWorkbook.path
f = "reportPageImpression.xlsx"
s = "report_page_impression"
a = "D39"

checkSheetResult = CheckSht(p, f) ' check if the file to be read as closed is not already opened and if it exists
If checkSheetResult = "" Then

    argPart = "'" & p & "[" & f & "]" & s & "'!" 'set the "constant" part of the argument

    var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1)

    If var = -1 Then
        MsgBox ("No value found!")
    Else
        ActiveSheet.Cells(Range("C8").row, Columns.Count).End(xlToLeft).Offset(0, 1) = var
    End If

Else
    MsgBox checkSheetResult
End If

End Sub


Private Function GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variant

Dim arg As String, funcArg As String
Dim var As Variant
Dim rowOffset As Long

If IsMissing(rowOffsetRate) Then rowOffsetRate = 0

rowOffset = 0

funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
var = ExecuteExcel4Macro(funcArg)
Do While var = -1 And CheckIfOffset(ref, CLng(rowOffsetRate), rowOffset)
    funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
    var = ExecuteExcel4Macro(funcArg)
Loop

If var <> -1 Then var = ExecuteExcel4Macro(arg)

GetFirstNonEmptyValueFromClosedWorkbook = var

End Function

Private Function SetArgFunction(ref As String, argPart As String, rowOffset As Long, arg As String) As String

arg = argPart & Range(ref).Range("A1").Offset(rowOffset).Address(, , xlR1C1)
SetArgFunction = "IF(COUNTA(" & arg & ")>0,1,-1)"

End Function


Private Function CheckIfOffset(ref As String, rowOffsetRate As Long, rowOffset As Long) As Boolean
Dim nextRow As Long
Dim cell As Range

Set cell = Range(ref)

nextRow = cell.Offset(rowOffset).row + rowOffsetRate

CheckIfOffset = rowOffsetRate > 0 And nextRow <= cell.Parent.Cells(cell.Parent.Rows.Count, 1).row _
                Or (rowOffsetRate < 0 And nextRow > 0)

If CheckIfOffset Then rowOffset = rowOffset + rowOffsetRate

End Function


Private Function CheckSht(path As String, file As String) As String
Dim wb As Workbook
Dim okSheet As Boolean

If Right(path, 1) <> "\" Then path = path & "\"

On Error Resume Next
Set wb = Workbooks(file)
On Error GoTo 0

okSheet = wb Is Nothing
If Not okSheet Then okSheet = wb.path & "\" <> path

If Not okSheet Then
    ' file is already open
    CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "is already open!"
Else
    'Let’s check whether the file exists
    If Dir(path & file) = "" Then CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "not found!"
End If

End Function

    the "logic" of shifting to a different cell is all in var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1) where that -1 is the "rowOffsetRate" that GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variantfunction takes into account if the cell in address a is empty. if no "rowOffsetRate" is passed then it only checks the cell in address a