All,
I currently have a VBA macro that I have created. I now need to change this code from what it is, and make it return a new set of data. Here is the current code:
Public Sub Import_TCR_Info1()
Dim FName As Variant
Dim Sep As String, MyPath As String, LineString As String, TCRDate As String
Dim OfficeRange As Range
Dim lngLineCount As Integer
Dim MyValue As Double
Set OfficeRange = Range("Offices")
MyPath = "E:\Data\RCC\TCR Recon\TCR Bag Deposit Reports\"
TCRDate = Format(Range("TCRDate"), "mmddyy")
Sheets("De La Rue Location").Activate
Range("InfoArea").ClearContents
Range("InfoArea").Cells(1, 1).Activate
For Each cell In OfficeRange
SourceFile = MyPath & TCRDate & "_TCR_" & Format(cell.Value, "0##") & ".csv"
ActiveCell.Value = cell.Value
If Len(Dir(SourceFile)) = 0 Then
SourceFile = ""
ActiveCell.Offset(0, 1).Range("A1:H1").Value = 0
Else
lngLineCount = 0
fn = FreeFile
Open SourceFile For Input As #fn
'moves line by line until it reaches the last line (EOF = end of file)
Do While Not EOF(fn)
Line Input #fn, LineString
lngLineCount = lngLineCount + 1
Loop
ParseDelimitedString LineString, ","
ActiveCell.Offset(0, 1).Value = MyArray(5)
ActiveCell.Offset(0, 2).Value = MyArray(6)
ActiveCell.Offset(0, 3).Value = MyArray(7)
ActiveCell.Offset(0, 4).Value = MyArray(8)
ActiveCell.Offset(0, 5).Value = MyArray(9)
ActiveCell.Offset(0, 6).Value = MyArray(10)
ActiveCell.Offset(0, 7).Value = MyArray(11)
ActiveCell.Offset(0, 8).Value = MyArray(12)
End If
ActiveCell.Offset(0, 9).FormulaR1C1 = "= SUM(RC[-8]:RC[-1])"
ActiveCell.Offset(1, 0).Activate
Next
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Total"
ActiveCell.Offset(0, 1).Range("A1:I1").FormulaR1C1 = "=SUM(R[-" & OfficeRange.Rows.Count + 1 & "]C:R[-1]C)"
End Sub
Function ParseDelimitedString(InputString As String, SC As String) As Variant
Dim i As Integer, tString As String, tChar As String * 1
Dim sCount As Integer, ResultArray() As Variant
tString = ""
sCount = 0
For i = 1 To Len(InputString)
tChar = Mid$(InputString, i, 1)
If tChar = SC Then
sCount = sCount + 1
Redim Preserve ResultArray(1 To sCount)
ResultArray(sCount) = tString
tString = ""
Else
tString = tString & tChar
End If
Next i
sCount = sCount + 1
Redim Preserve ResultArray(1 To sCount)
Redim MyArray(1 To sCount)
ResultArray(sCount) = tString
MyArray = ResultArray
End Function
Basically we have about 80 files that we get each day, and this macro opens all of the files, and gives us the totals in each file. The file names are pretty constant each day, except the date changes on each one (the file is named for each machine).
What I need for it to do now, is to take all data from the file EXCEPT the last line, and put the info into a new tab of the current worksheet. As it takes the data from file B, it would append to the data in set A, and so on so that the worksheet will have all of the data from all of the files in it. The rest of the macro I can write on my own ( sorting the new data set, and subtotaling it by machine number), but I cannot seem to be able to alter this macro to return the data set I need.
Any thoughts, hints, tips, anything at all would be majorly appreciated. Thank you for any help that you can be.
Also, if modifying this code is not the way to go, what are your suggestions?
Bookmarks