Create Workbook and move data

**Andy Pope** · Jul 19th 2004

You have put the MyLoad within the loop on the input filenames?

Code

For i = LBound(FileName) To UBound(FileName) 
    MyLoad ThisWorkbook.Path & "\", CStr(FileName(i))
Next i

Eskkimo · Jul 19th 2004

err, I had caught that... here is my code now... the one that doesn't hang but doesn't work either...

Code

'   Display full path and name of the files
    For i = LBound(FileName) To UBound(FileName)
        Msg = Msg & FileName(i) & vbCrLf
    Next i
    MsgBox "You selected:" & vbCrLf & Msg
End Sub
Sub DailyLoad(Path As String, FileName As Variant)
    Dim FileName As Variant
    Dim i As Long
        Application.ScreenUpdating = False
        ' under normal use the MyLoad would only be called once
        MyLoad ThisWorkbook.Path & "\", CStr(FileName(i))
    Application.ScreenUpdating = True
End Sub
Function GetOutput(Name As String) As Workbook
    On Error Resume Next
    Set GetOutput = Workbooks.Open(Name)
    If Err.Number <> 0 Then
        Set GetOutput = Workbooks.Add
        GetOutput.SaveAs Name
    End If
    Exit Function
End Function
Sub MyLoad(Path As String, Name As String)

Display More

Eskkimo · Jul 19th 2004

This one works too... but we have to type the filename in... and only one at a time

Code

Option Explicit
Sub EnterFilename()
    Dim Filename As String
    Dim FirstSpace As String
    Do Until Filename <> ""
        Filename = InputBox("Enter Filename: ", "Identify Downloaded File")
    Loop
    FirstSpace = InStr(Filename, " ")
    If FirstSpace <> 0 Then
        Filename = Left(Filename, FirstSpace)
    End If
    MsgBox Filename & "will be sent through 'Test Run' program"


    Application.ScreenUpdating = False
    
    MyLoad ThisWorkbook.Path & "\", Filename
    
    Application.ScreenUpdating = True
End Sub


Function GetOutput(Name As String) As Workbook


    On Error Resume Next
    Set GetOutput = Workbooks.Open(Name)
    If Err.Number <> 0 Then
        Set GetOutput = Workbooks.Add
        GetOutput.SaveAs Name
    End If
    Exit Function
End Function


Sub MyLoad(Path As String, Name As String)

Display More

Eskkimo · Jul 19th 2004

And this was the original... the one that would run more than one file at a time.

Code

Sub DailyLoad()


    Application.ScreenUpdating = False
    
    ' under normal use the MyLoad would only be called once
    
    MyLoad ThisWorkbook.Path & "\", "DownloadedSpreadsheet.xls"
    MyLoad ThisWorkbook.Path & "\", "SecondDwnldSpreadsheet.xls"
    MyLoad ThisWorkbook.Path & "\", "ThirdDownloadedSpreadsheet.xls"
    MyLoad ThisWorkbook.Path & "\", "Fourth.xls"
    MyLoad ThisWorkbook.Path & "\", "Fifth.xls"
    MyLoad ThisWorkbook.Path & "\", "Sixth.xls"


    Application.ScreenUpdating = True
End Sub


Function GetOutput(Name As String) As Workbook

Display More

**Andy Pope** · Jul 19th 2004

Try this version.

Code

Sub GetImportFileName2()
    Dim Filt As String
    Dim FilterIndex As Long
    Dim Title As String
    Dim FileNames As Variant
    Dim i As Long
     
     '   Set up list of file filters
    Filt = "Microsoft Excel Worksheet (*.xls),*.xls," & _
    "Comma Separated Files (*.csv),*.csv,"
     '   Display *.* by default
    FilterIndex = 5
     'Set the dialog box caption
    Title = "Select a File to Import"
     'Get the file name
    FileNames = Application.GetOpenFilename _
    (FileFilter:=Filt, _
    FilterIndex:=FilterIndex, _
    Title:=Title, _
    MultiSelect:=True)
     '   Exit if dialog box canceled
    If Not IsArray(FileNames) Then
        MsgBox "No file was selected."
        Exit Sub
    End If
     
    Application.ScreenUpdating = False
     '   Display full path and name of the files
    For i = LBound(FileNames) To UBound(FileNames)
        MyLoad ThisWorkbook.Path & "\", CStr(FileNames(i))
    Next i
    Application.ScreenUpdating = True
End Sub

Display More

Eskkimo · Jul 20th 2004

It doesn't work. :? The body of the program

Code

Sub MyLoad(Path As String, Name As String)
    Dim wbkDownload As Workbook
    Dim wbkOutput As Workbook
    Dim lngRow As Long
    Dim lngRowOut As Long
    Dim strNumber As String
    
    Set wbkDownload = Workbooks.Open(Path & Name)
    lngRow = 2
    Do While wbkDownload.Worksheets(1).Cells(lngRow, 2) <> ""
        strNumber = wbkDownload.Worksheets(1).Cells(lngRow, 2)
        Set wbkOutput = GetOutput(Path & strNumber & ".xls")
        lngRowOut = wbkOutput.Worksheets(1).Range("A65536").End(xlUp).Row
        If lngRowOut = 1 Then
            ' need header
            wbkDownload.Worksheets(1).Rows(1).Copy wbkOutput.Worksheets(1).Range("a1")
        End If
        lngRowOut = lngRowOut + 1
        wbkDownload.Worksheets(1).Rows(lngRow).Copy wbkOutput.Worksheets(1).Range("a" & lngRowOut)
        wbkOutput.Close True
        lngRow = lngRow + 1
    Loop
    wbkDownload.Close False
End Sub

Display More

doesn't like filenames as a Variant... or something.

There is an error targeting

Code

Set wbkDownload = Workbooks.Open(Path & Name)

It couldn't find the workbook... and the path it refers to is funky. It says

Run-time error '1004':

'C:\Documents and Settings\Owner\Desktop\Test Run\C:\Documents and Settings\Owner\Desktop\Test Run\EMPIRE07142004.csv' could not be found. Check the spelling of the file name, and verify that the file location is correct.

If you are trying to open the file from your list of most recently used files on the File menu. make sure that the file has not been renamed.

End Debug Help

**Andy Pope** · Jul 20th 2004

Ah, the filenames returned from using the GetOpenFilename include the path already.
So you need to break the path and filename inorder to pass 2 arguments.

I have updated the example code.

Eskkimo · Jul 20th 2004

Something weird is happening. First, I assumed the new part of the code needed to be the first sub-routine in the code.

It works (no compile errors) but it has crashed Excel a couple of times (but not every time). When this crash happens, the 19 new files have been created but the program decides to create a 20th file. It doesn't have a downloaded file to use to make a name so it calls it Book 20 and then sometimes Book 21... but crashes soon.

Several times, when it doesn't crash, it is has created the 19 new files but only put 3 or 1 of the 6 downloaded files data in them. hmmmmm... this is getting very interesting. smile, smile.

I'll keep looking at it. Lets keep working on it. Your code is amazing. I couldn't do this without you.

**Andy Pope** · Jul 20th 2004

The order of routines within a module in not important.

The one that you need to run though is GetImportFileName2

I have run it a couple of timws now of the 6 data files you provided without problem. That include removing a few of the created workbooks between attempts.

When you say that Excel crashes do you mean it really crashes or that it produces an error, perhaps offering you the choice to go to debug mode. If so what is the error.

Eskkimo · Jul 20th 2004

Excell crashes. All files are closed and no changes to anything is saved. The subroutine GetImportFileName2 is at the end of the code and the first sub DailyLoad is still at the begining... with the six downloaded files spelled out right in the code. Is that the way it should be? Is that what you have that is working?

hmmm... I wonder if I changed something that I shouldn't have. :o\

**Andy Pope** · Jul 20th 2004

Here the latest version of the workbook. Let us know how you get on.

Eskkimo · Jul 20th 2004

Well, this last one works. I was careful to put only the things you have (those six sample data files) through it. Ahhh. thank you. I understand more now about how the subs don't need to be in order as long as I run that macro.

Smiles,
Eva

Eskkimo · Jul 21st 2004

Can you see what I'm trying to do. I simply want to delete a column. After emulating what a macro record session says, I realized that "that" code was only deleting the first cell in the column. I then tried copying columns H:M to G:L (shifting everything over). I've gone round and round and it just gets more complicated... which is the wrong direction to go. What do I do?

Code

Sub MyLoad(Path As String, Name As String)
    Dim wbkDownload As Workbook
    Dim wbkOutput As Workbook
    Dim i As Long
    Dim j As Long
    Dim SixColumns As Range
    Dim lngRow As Long
    Dim lngRowOut As Long
    Dim strNumber As String
    
    Set wbkDownload = Workbooks.Open(Path & Name)
    lngRow = 2
    Do While wbkDownload.Worksheets(1).Cells(lngRow, 2) <> ""
        strNumber = wbkDownload.Worksheets(1).Cells(lngRow, 2)
        Set wbkOutput = GetOutput(Path & strNumber & ".xls")
        lngRowOut = wbkOutput.Worksheets(1).Range("A65536").End(xlUp).Row
        If lngRowOut = 1 Then
            ' need header
            wbkDownload.Worksheets(1).Rows(1).Copy wbkOutput.Worksheets(1).Range("a1")
            Columns("C:C").ColumnWidth = 15.43
            i = Cells(65536, 8).End(xlUp).Row
            Worksheets(1).Range("H:M" & i).AdvancedFilter Action:=xlFilterCopy, _
                CopyToRange:=Range("H:M"), Unigue:=True
            j = Cells(65536, 8).End(xlUp).Row
            With Range("H:M" & j)
                Set SixColumns = Range("G:L" & j)
                .Copy
            End With
        End If
        lngRowOut = lngRowOut + 1
        wbkDownload.Worksheets(1).Rows(lngRow).Copy wbkOutput.Worksheets(1).Range("a" & lngRowOut)
        wbkOutput.Close True
        lngRow = lngRow + 1
    Loop
    wbkDownload.Close False
End Sub

Display More

**Andy Pope** · Jul 21st 2004

Hi Eva,

Are you just trying to NOT include column G in the output workbooks?

Eskkimo · Jul 22nd 2004

yes, column G and column J. My code looks pretty rediculous but the simple stuff wouldn't work. They also asked me to move a couple of columns around... and, as you can see, change the width of a few (that was the only easy one)

Eskkimo · Jul 22nd 2004

Yep. I thought so. I've just tried inserting simple code to move a column which works when I do it by hand... and works when I run a recorded macro... but only moves the first cell of the column when I insert the same code into the body of our previous code. :?

**Andy Pope** · Jul 22nd 2004

Hi,

I have added a routine which allows you to format, move and remove the columns you need.
It has as an argument the current output row. So references are local to that range not the worksheet as a whole.
Currently it sets the columns width of C and remove G.

Eskkimo · Jul 22nd 2004

It took me a couple minutes... but I think I understand. The original code references the current row (hence, only row one) but the separate subroutine is not locked into that rule. It references the whole sheet (hence, the entire column of rows). whew! Thanks. I will start using more subroutines... I'm coming from old school programing (FORTRAN, C, C++)

You're tons of help. Thanks.

Eskkimo · Jul 31st 2004

Hello Masters of VBA,

I've found a new snag. I loaded the great program we came up with onto my brother's new laptop to test it on another computer. He bought a used thinkpad, P3 and I loaded Windows XP and Office 97 onto it. So, I copy the .xls file with the macro onto his desktop and run it. To my suprise, there is a compile error. It says " sub or function not defined " and targets InStrRev in the VBA code. Here is the part of the code where it resides.

Code

Application.ScreenUpdating = False
     '   Display full path and name of the files
    For i = LBound(FileNames) To UBound(FileNames)
        strPath = Left(FileNames(i), InStrRev(FileNames(i), "\"))
        strFile = Mid(FileNames(i), Len(strPath) + 1)
        MyLoad strPath, strFile
    Next i

Any ideas why?

Eskkimo · Jul 31st 2004

I seemed to have solved my own problem. I updated the Office 98 with an Office 2000 upgrade disk. Now the program works exactly the same as when it's on my computer.

Create Workbook and move data

Participate now!

Share