VBA Program Results Not Going to Current Worksheet

Question

I'm new to VBA. Based on information I've found in this forum, I've been able to successfully create a functional macro but with a few issues remaining. The purpose of the macro is to build a dataset from a directory full of xls* files. Works great mostly. Many thanks for those who posted what I started with.

The problem is that each time I execute, it creates the answer set in Sheet1 of a new Workbook. I would like the answer set to go either into the current sheet of the current workbook or alternatively go into the "Data" sheet of a specific workbook. In this case, I'd really like for the answer set to be in the xlsm file where the macro is located. I've not been able to locate a working solution. More accurately, I don't understand why this isn't going to my current worksheet by default as documentation seems to indicate that it should.

One other question. In the following code, it is relatively simple for a neophyte to follow/adjust the Sub code. However, can someone explain (generally) the Private Function code? Though it works, I'm having difficulty understanding technically what it is doing.

Sub ReadDataFromAllWorkbooksInFolder()
    Dim FolderName As String, wbName As String, r As Long, cValue As Variant
    Dim fs, f, s
    Dim wbList() As String, wbCount As Integer, i As Integer, Lead As Integer
    Dim CheckIN As Date, CheckOUT As Date
    Dim Total As Currency, Deposit As Currency, Balance As Currency, STax As Currency, CTax As Currency, TTax As Currency
    Dim Rent As Currency, Pet As Currency, Cleaning As Currency, HotTub As Currency
    Dim BookDate As Date, Origin As Date



    FolderName = "C:\Users\Ken\Documents\Personal\Ferguson House\Contracts\Sample"
    ' create list of workbooks in foldername' --- Comment
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls*")
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
        ' get values from each workbook' --- Comment
        r = 1
        Workbooks.Add
        For i = 1 To wbCount
            r = r + 1
            House = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "I1")
            Name = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c2")
            Address = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c3")
            Phone = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c4")
            Fax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c5")
            Email = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c6")
            Total = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d10")
            Deposit = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d11")
            Balance = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d12")
            STax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c55")
            CTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c56")
            TTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c57")
            Rent = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c51")
            Pet = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i16")
            Cleaning = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i14")
            HotTub = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i15")
            CheckIN = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i2")
            CheckOUT = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "g44")
            NIGHTS = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i3")
            BookDt = FolderName & "\" & wbList(i)
            BookDate = FileDateTime(BookDt)
            Origin = Int(BookDate)
            Lead = CheckIN - Origin
            Cells(r, 1).Value = wbList(i)
            Cells(r, 2).Value = House
            Cells(r, 3).Value = Name
            Cells(r, 4).Value = Address
            Cells(r, 5).Value = Phone
            Cells(r, 6).Value = Fax
            Cells(r, 7).Value = Email
            Cells(r, 8).Value = Total
            Cells(r, 9).Value = Deposit
            Cells(r, 10).Value = Balance
            Cells(r, 11).Value = STax
            Cells(r, 12).Value = CTax
            Cells(r, 13).Value = TTax
            Cells(r, 14).Value = Rent
            Cells(r, 15).Value = Pet
            Cells(r, 16).Value = Cleaning
            Cells(r, 17).Value = HotTub
            Cells(r, 18).Value = CheckIN
            Cells(r, 19).Value = CheckOUT
            Cells(r, 20).Value = NIGHTS
            Cells(r, 21).Value = Origin
            Cells(r, 22).Value = Lead

        Next i

        'Create Headers
        Range("$A$1").Value = "Contract"
        Range("$B$1").Value = "House #"
        Range("$C$1").Value = "Name"
        Range("$D$1").Value = "Address"
        Range("$E$1").Value = "Phone"
        Range("$F$1").Value = "Fax"
        Range("$G$1").Value = "Email"
        Range("$H$1").Value = "Total"
        Range("$I$1").Value = "Deposit"
        Range("$J$1").Value = "Balance"
        Range("$K$1").Value = "St Tax"
        Range("$L$1").Value = "Cty Tax"
        Range("$M$1").Value = "Tot Tax"
        Range("$N$1").Value = "Rent Only"
        Range("$O$1").Value = "Pet Fee"
        Range("$P$1").Value = "Cleaning"
        Range("$Q$1").Value = "Hot Tub"
        Range("$R$1").Value = "Check In"
        Range("$S$1").Value = "Check Out"
        Range("$T$1").Value = "Nights"
        Range("$U$1").Value = "Book Dte"
        Range("$V$1").Value = "Lead Time"
        Range("A1:V1").Font.Bold = True

End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
    wbName As String, wsName As String, cellRef As String) As Variant
    Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function
    arg = "'" & wbPath & "[" & wbName & "]" & _
        wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

Answer 1

The Function is a good approach -what is doing is basically saving you the time of open the desired WB and instead retrieving the data straight forward-.
In a "normal" process you would need to
1. Open the WB
2. Select the sheet
3. Get the desired value
4.Close the WB
This functions relies on the fact that you can type a formula in Excel that retrieves the desired value from a closed wb. You may try for yourself in ExcelSheet ='C:\MyUser\Documents\[DesiredWB.xls]Sheet1'!$A$2 ->this is faster than doing the 4 steps mentioned above isn't?
However, this seems like a "quick fix".
I faced a similar situation and came with this solution that basically does the same,but, has more error handling. -I'll do the example for "House"
1. First, verify the desired sheet exists in the WB:

Function SheetExistsFDB(ShtName$, WbPath$) As Boolean
Dim GV, ParentFolder$, FileName$, PD%
'Split to folder and file name

PD = InStrRev(WbPath, "\")
ParentFolder = Left(WbPath, PD - 1)
FileName = Mid(WbPath, PD + 1)


' also can be used to get the value RV from a specified Row Col if you need it
GV = ExecuteExcel4Macro("'" & ParentFolder & "\[" & FileName & "]" & ShtName & "'!R1C1")
SheetExistsFDB = CStr(GV) <> "Error 2023"
' MsgBox CStr(GV)
End Function

2. Use this formula to just type the formula as described:

Sub WriteFormulasvalues(iFilePath As String, iFilename As String, iSheet As String, iRC As String, iRange As Range, Optional AdditionalText As String)
myFormula = "='" & iFilePath & "[" & iFilename & "]" & iSheet & "'!" & iRC & ""
    With iRange
    .Formula = myFormula
    .Value = AdditionalText & .Value
    End With
End Sub

Since all your variables use the same name sheet, I'd use something like

For i = 1 To wbCount
Dim RealPath
RealPath = FolderName & wbList(i)
If SheetExistsFDB("Contract", RealPath) = True Then ' 1. If SheetExistsFDB(RealPath, "Contract") = True
        r = r + 1
        'House used as example correct others
        Call WriteFormulasvalues(FolderName, wbList(i), "Contract", "R1C9", Cells(r, 2)) 'I used RC format so according to your code I1= R1C9

        Name = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c2")
        Address = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c3")
        Phone = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c4")
        Fax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c5")
        Email = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c6")
        Total = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d10")
        Deposit = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d11")
        Balance = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d12")
        STax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c55")
        CTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c56")
        TTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c57")
        Rent = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c51")
        Pet = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i16")
        Cleaning = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i14")
        HotTub = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i15")
        CheckIn = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i2")
        CheckOut = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "g44")
        NIGHTS = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i3")
        BookDt = FolderName & "\" & wbList(i)
        BookDate = FileDateTime(BookDt)
        Origin = Int(BookDate)
        Lead = CheckIn - Origin
        Cells(r, 1).Value = wbList(i)
        'Cells(r, 2).Value = House no longer needed since WriterFormulas does it
        Cells(r, 3).Value = Name
        Cells(r, 4).Value = Address
        Cells(r, 5).Value = Phone
        Cells(r, 6).Value = Fax
        Cells(r, 7).Value = Email
        Cells(r, 8).Value = Total
        Cells(r, 9).Value = Deposit
        Cells(r, 10).Value = Balance
        Cells(r, 11).Value = STax
        Cells(r, 12).Value = CTax
        Cells(r, 13).Value = TTax
        Cells(r, 14).Value = Rent
        Cells(r, 15).Value = Pet
        Cells(r, 16).Value = Cleaning
        Cells(r, 17).Value = HotTub
        Cells(r, 18).Value = CheckIn
        Cells(r, 19).Value = CheckOut
        Cells(r, 20).Value = NIGHTS
        Cells(r, 21).Value = Origin
        Cells(r, 22).Value = Lead
End If ' 1. If SheetExistsFDB(RealPath, "Contract") = True
    Next i
Sub WriteFormulasvalues(iFilePath As String, iFilename As String, iSheet As String, iRC As String, iRange As Range, Optional AdditionalText As String)
myFormula = "='" & iFilePath & "[" & iFilename & "]" & iSheet & "'!" & iRC & ""
    With iRange
    .Formula = myFormula
    .Value = AdditionalText & .Value
    End With
End Sub

Answer 2

Any time you use a reference like Cells(r, 1).Value or Range("$K$1").Value what you are implicitly saying is you want ActiveSheet.Cells(r, 1).Value or ActiveSheet.Range("$K$1").Value.

The solution to this is to use fully qualified references. Don't let Excel assume anything.

So instead of just doing

Workbooks.Add

Do

Dim myDestinationSheet As Worksheet
Dim myDestinationWorkbook As Workbook
Set myDestinationWorkbook = Workbooks.Add
Set myDestinationSheet = myDestinationWorkbook.Sheets(1)
myDestinationSheet.Name = "Data"
myDestinationSheet.Cells(1,1).value = House

You should use this technique to resolve any possible ambiguity in object references on every line of code you write. Even if you use ActiveSheet like might be the default it is best to use it explicitly.

Answer 3

Workbooks.Add is creating a new workbook.

The un-qualified Cells object, where you're assigning data to the "current" sheet, will always revert to whatever worksheet is active at run-time. Adding a workbook makes that book Active, and by default the Sheet1 object will be active in that workbook.

I suspect that simply getting rid of Workbooks.Add will resolve the problem, but you may need further tweak to explicitly activate the sheet on which you desire the code to be placed, such as:

    With ThisWorkbook.Sheets("YOUR SHEET NAME") ' ## MODIFY AS NEEDED!
        .Cells(r, 1).Value = wbList(i)
        .Cells(r, 2).Value = House
        .Cells(r, 3).Value = Name
        .Cells(r, 4).Value = Address
        .Cells(r, 5).Value = Phone
        .Cells(r, 6).Value = Fax
        .Cells(r, 7).Value = Email
        .Cells(r, 8).Value = Total
        .Cells(r, 9).Value = Deposit
        .Cells(r, 10).Value = Balance
        .Cells(r, 11).Value = STax
        .Cells(r, 12).Value = CTax
        .Cells(r, 13).Value = TTax
        .Cells(r, 14).Value = Rent
        .Cells(r, 15).Value = Pet
        .Cells(r, 16).Value = Cleaning
        .Cells(r, 17).Value = HotTub
        .Cells(r, 18).Value = CheckIN
        .Cells(r, 19).Value = CheckOUT
        .Cells(r, 20).Value = NIGHTS
        .Cells(r, 21).Value = Origin
        .Cells(r, 22).Value = Lead
    End With

NOTE: You'll need to do the same thing with your header assignments, too.