Hi There,
I'm trying to pass a multidimensional array from one workbook into another in an effort to make a comprehensive summary of project status for all-time. I don't know what's going on but, all of the data makes it into the array, but when I try to move it over to the next workbook it changes types or something and I don't think it's recognized as an Array anymore. Anyone understand why it would be doing this? Or am i just declaring some Variables incorrectly? I have tried battling with this for a while now...
I'm dealing with the following two pieces of code:
Sub SelectFiles()
Dim IntDump As Integer
Dim wkBookName As String
Dim DataArray As Variant
Dim NewArray() As Long
ArTemp = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", MultiSelect:=True)
'(where ArTemp is a variant)
For i = 1 To UBound(ArTemp)
myfile = ArTemp(i)
Workbooks.OpenText Filename:=myfile
' (do suff with this file)
wkBookName = GetFilenameFromPath(myfile)
Workbooks(wkBookName).Activate
NewArray = Application.Run("'" & ActiveWorkbook.Name & "'" & "!ThisWorkbook.RetrieveData")
'ReDim NewArray(1 To UBound(DataArray), 1 To 11)
ThisWorkbook.Activate
'Create a new worksheet to dump data, if it's already open, clear it's data.
Set wSheet = Sheets("Data Dump")
If wSheet Is Nothing Then
Worksheets.Add.Name = "Data Dump"
Else
Worksheets("Data Dump").Cells.ClearContents
End If
'Worksheets("Data Dump").Cells(1, 1).Value = RetrieveData(1, 1)
'MsgBox (UBound(DataArray))
MsgBox (UBound(DataArray))
'NumberOfDays = UBound(DataArray)
'MsgBox (NumberOfDays)
For IntDump = 1 To NumberOfDays
Worksheets("Data Dump").Cells(IntDump, 1).Value = DataArray(IntDump, 1)
Worksheets("Data Dump").Cells(IntDump, 2).Value = DataArray(IntDump, 2)
Worksheets("Data Dump").Cells(IntDump, 3).Value = DataArray(IntDump, 3)
Worksheets("Data Dump").Cells(IntDump, 4).Value = DataArray(IntDump, 4)
Worksheets("Data Dump").Cells(IntDump, 5).Value = DataArray(IntDump, 5)
Worksheets("Data Dump").Cells(IntDump, 6).Value = DataArray(IntDump, 6)
Worksheets("Data Dump").Cells(IntDump, 7).Value = DataArray(IntDump, 7)
Worksheets("Data Dump").Cells(IntDump, 8).Value = DataArray(IntDump, 8)
Worksheets("Data Dump").Cells(IntDump, 9).Value = DataArray(IntDump, 9)
Worksheets("Data Dump").Cells(IntDump, 10).Value = DataArray(IntDump, 10)
Worksheets("Data Dump").Cells(IntDump, 11).Value = DataArray(IntDump, 11)
Next IntDump
MsgBox ("Success Dumping Data")
Next i
End Sub
Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'
' e.g. 'c:\winnt\win.ini' returns 'win.ini'
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Option Base 1
Public Function RetrieveData() As Long()
Dim IntPull As Integer, _
IntDump As Integer, _
wSheet As Worksheet, _
RowCount As Integer, _
DataStartRow As Double, _
DataFinishRow As Double, _
NumberOfDays As Integer
Dim DataArray() As Long
Worksheets("Weekly Output").Select
Range("H3").Select
Do Until Selection.Value <> 0
Selection.Offset(1, 0).Select
Loop
DataStartRow = ActiveCell.Row
Range("H3").End(xlDown).Offset(1, 0).Select
Do Until Selection.Value <> 0
Selection.Offset(-1, 0).Select
Loop
DataFinishRow = ActiveCell.Row
'MsgBox (DataStartRow & " + " & DataFinishRow)
Range("H" & DataStartRow, "H" & DataFinishRow).Select
NumberOfDays = DataFinishRow - DataStartRow + 1
ReDim DataArray(1 To NumberOfDays, 1 To 11) As Long
RowCount = DataStartRow
For IntPull = 1 To NumberOfDays
DataArray(IntPull, 1) = Worksheets("Weekly Output").Cells(RowCount, 1).Value
DataArray(IntPull, 2) = Worksheets("Weekly Output").Cells(RowCount, 2).Value
DataArray(IntPull, 3) = Worksheets("Weekly Output").Cells(RowCount, 3).Value
DataArray(IntPull, 4) = Worksheets("Weekly Output").Cells(RowCount, 8).Value
DataArray(IntPull, 5) = Worksheets("Weekly Output").Cells(RowCount, 9).Value
DataArray(IntPull, 6) = Worksheets("Weekly Output").Cells(RowCount, 14).Value
DataArray(IntPull, 7) = Worksheets("Weekly Output").Cells(RowCount, 15).Value
DataArray(IntPull, 8) = Worksheets("Weekly Output").Cells(RowCount, 20).Value
DataArray(IntPull, 9) = Worksheets("Weekly Output").Cells(RowCount, 21).Value
DataArray(IntPull, 10) = Worksheets("Weekly Output").Cells(RowCount, 26).Value
DataArray(IntPull, 11) = Worksheets("Weekly Output").Cells(RowCount, 27).Value
RowCount = RowCount + 1
Next IntPull
MsgBox ("Success on inputting data into array")
'MsgBox ("Array Size is " & UBound(DataArray) - LBound(DataArray) + 1 & " Given size of " & NumberOfDays - 1)
'MsgBox (UBound(DataArray))
'Create a new worksheet to dump data, if it's already open, clear it's data.
Set wSheet = Sheets("Data Dump")
If wSheet Is Nothing Then
Worksheets.Add.Name = "Data Dump"
Else
Worksheets("Data Dump").Cells.ClearContents
End If
MsgBox (UBound(DataArray))
RetrieveData = DataArray()
End Function
Bookmarks