Create Workbook and move data

**Andy Pope** · Aug 5th 2004

Hi,

The InStrRev() function is not available in xl97
You would need to write your own function if this is to be used on xl97

Eskkimo · Aug 8th 2004

I am now working on adding a column to the left of the spreadsheet. This is easy enough but then I need all the incoming data to be put into cells to the right of this added column. Instead of data put in columns A through K, it needs to be put in columns B through L.

The program takes the row from wbkDownload and copies it into wbkOutput. That line of code looks like this

Code

wbkDownload.Worksheets(1).Rows(lngRow).Copy_
     wbkOutput.Worksheets(1).Range("a" & lngRowOut)

So it defines the range with ("a" & lngRowOut) . longRowOut is a counter counting the rows. What is "a" defining? I thought it was the column it started but when I tried changing it to "b", it didn't like it.

It said I was trying to put something somewhere and they weren't the same size. How can I get this to work?

I've attached the file with the code and an example of the Output file with the data in the wrong columns.

**Andy Pope** · Aug 8th 2004

Hi,

The problem is to do with copying a whole row at once.
In effect you are copying 256 cells and trying to put them in the new sheet start in column B, which will cause the last cell to be in 257 and this is not possible.

Two possible solutions to these problem.
The easiest is to use the row copy as is and the insert a cell in column A. In effect moving the information to the right.
To do that add this line after the copy statement.

wbkOutput.Worksheets(1).Range("A" & lngRowOut).Insert Shift:=xlToRight

The other solution is to get the exact information you need to copy and then you will be able to specifiy B as the output cell.

Eskkimo · Aug 8th 2004

Dang! That's so easy. I wish I had thought of it. Thanks.

By the way. I'm going to be putting the download file's date in this newly added column. It's embedded in the download file Name. I think I can do it. I'm planning on creating a new subroutine that will separate the date from the Name and insert it into the new column.

I couldn't think of how to do it within the subroutines that are already running. Am I right to just create a new sub?

Another task I've been asked to do is to format the cells in the downloaded file like I've done for the new worksheets. I haven't put as much thought into this one - but will another subroutine be appropriate for this task?

**Andy Pope** · Aug 8th 2004

Hi,

It sounds like you need a function to extract the date from the filename and output it to a cell. If you need help with that then post back with the filename construction.

Yes another sub to format cells sounds just right.

Eskkimo · Aug 8th 2004

Thanks Andy,

Here is what the first filenames will look like, "EMPIRE062920040913.csv". There will always be four random numbered digits after the date.

I'm not sure why I'm having problems with our previous "insert a cell in front of the row" thing. The insertion of a cell is working great, BUT there are two quirks that have cropped up. All I changed was adding that cell to the left (for both the header and the body) and re-adjusting the column formating

1) The formating of columns for the header (first row) is jumbling things up. Certain columns are not shifted over and extra columns are deleted. This is extra baffling because the formating of columns for the rest of the data (rows 2 and on) is perfect. ??? The same subroutine controls both of them.

2) Each new row of data is being put in the second row, overwriting the previous days information. It's as if the loop isn't working. ???

Here is the code

Code

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")
        Application.StatusBar = "Input:[" & Name & "] Output:[" & wbkOutput.Name & "]"
        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")
            ' add cell to left of row
            wbkOutput.Worksheets(1).Range("A" & lngRowOut).Insert Shift:=xlToRight
            FormatColumns wbkOutput.Worksheets(1).Rows(1)
        End If
        lngRowOut = lngRowOut + 1
        ' copy row from downloaded file to new worksheet
        wbkDownload.Worksheets(1).Rows(lngRow).Copy wbkOutput.Worksheets(1).Range("a" & lngRowOut)
        ' add cell to left of row
        wbkOutput.Worksheets(1).Range("A" & lngRowOut).Insert Shift:=xlToRight
        FormatColumns wbkOutput.Worksheets(1).Rows(lngRowOut)
        wbkOutput.Close True
        lngRow = lngRow + 1
    Loop
    wbkDownload.Close False

Display More

and then the formating code

Code

Sub FormatColumns(MyData As Range)
'
' Remove and move around data for the current row
'
    With MyData
        Columns("F:G").Select
        Selection.Cut
        Columns("D:D").Select
        Selection.Insert Shift:=xlToRight
        Columns("H:H").Select
        Selection.Delete Shift:=xlToLeft
        Columns("J:J").Select
        Selection.Delete Shift:=xlToLeft
        Columns("L:L").ColumnWidth = 11.29
        Selection.ColumnWidth = 17.86
        Selection.ColumnWidth = 16
        Columns("I:I").ColumnWidth = 15.14
        Columns("H:H").ColumnWidth = 4.71
        Columns("G:G").ColumnWidth = 4.14
        Columns("F:F").ColumnWidth = 15.71
        Columns("E:E").ColumnWidth = 3.29
        Columns("D:D").ColumnWidth = 5
        Columns("C:C").ColumnWidth = 6.14
        Columns("B:B").ColumnWidth = 4.86
        Cells.Select
        With Selection
            .HorizontalAlignment = xlCenter
        End With
        Range("A2").Select
        ActiveWindow.FreezePanes = True
    End With


End Sub

Display More

I'll attach the messed up new worksheet and the file to download. That dowload file is really a .csv but I had to change it to .xls to attach it.

**Andy Pope** · Aug 9th 2004

The attached contains a function to extract the date from the filename.

The format subroutine is not working properly as object references are not quite right. The dot is missing from the column reference.

It should be like this

.Columns("F:G").Select

Eskkimo · Aug 9th 2004

Andy!!! You are amazing. Thanks!

Adding that download date was much simpler than what I was planning. Yea!!!!! :rock:

I had to mess around with the formating but I finally got it right.

Why did we have to put "Dim lngRow As Long" in the formating subroutine? It obviously fixed the 2nd row being overwritten every time... but it was working correctly before when we did not have it in the formating sub.

Eva

**Andy Pope** · Aug 9th 2004

Hi Eva,

The Dim statement is something I left in there whilst I was testing the code. You can delete it.
When the .Column() syntax is used only the MyData row is selected with Column() the complete column is selected, this was the problem.

Eskkimo · Aug 15th 2004

Ahhh yes, You express yourself well. Thanks.

Now, I am stuck on the new sub that will format the downloaded file. I thought this would be simple but I must be missing something. Before I show the code I will mention that the downloaded file is coma delimited (.csv). After going round and round I noticed this and thought it might be the culprit.

Here is the code where I call the new sub (I tried it outside of the loop, inside the loop but outside of the If/Then loop and where it is now, inside the If/Then loop)

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")
        Application.StatusBar = "Input:[" & Name & "] Output:[" & wbkOutput.Name & "]"
        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")
            FormatColumns wbkOutput.Worksheets(1).Rows(1)
            wbkOutput.Worksheets(1).Range("A1").Insert Shift:=xlToRight
            Range("A1").Select
            ActiveCell.FormulaR1C1 = "Download Date"
            Range("A1").Select
            Selection.WrapText = True
            Range("L1").Select
            Selection.WrapText = True
            Columns("A:A").ColumnWidth = 8.14
            FormatDownload wbkDownload.Worksheets(1).Range("A:L")
        End If
        lngRowOut = lngRowOut + 1
        wbkDownload.Worksheets(1).Rows(lngRow).Copy wbkOutput.Worksheets(1).Range("a" & lngRowOut)
        FormatColumns wbkOutput.Worksheets(1).Rows(lngRowOut)
        wbkOutput.Worksheets(1).Range("A" & lngRowOut).Insert Shift:=xlToRight
        wbkOutput.Worksheets(1).Range("A" & lngRowOut) = GetDateFromFile(Name)
        wbkOutput.Close True
        lngRow = lngRow + 1
    Loop
    wbkDownload.Close False
End Sub

Display More

and here is the new sub

Code

Sub FormatDownload(RawData As Range)
    With RawData
        .Columns("A:A").ColumnWidth = 5
        .Columns("B:B").ColumnWidth = 5
        .Columns("C:C").ColumnWidth = 5
        .Columns("D:D").ColumnWidth = 5
        .Columns("E:E").ColumnWidth = 5
        .Columns("F:F").ColumnWidth = 5
        .Columns("G:G").ColumnWidth = 5
        .Columns("H:H").ColumnWidth = 5
        .Cells.Select
        With Selection
            .HorizontalAlignment = xlCenter
        End With
    End With
End Sub

Display More

**Andy Pope** · Aug 15th 2004

Hi Eva,

A bit confused what your are trying to do now. Appears to be a lot of conflicting code.

The new subroutine FormatDownload appears to be formating the .csv input file.
Firstly the formatting will not be retained with the csv file but more importantly the file is not saved anyway.

Assuming you meant to apply the changes to the output workbook then the column width values will all be changes when you run the FormatColumns subroutine.

Can you explain the purpose of FormatDownload.

Eskkimo · Aug 15th 2004

O.K.

The downloaded file is not formatted the way they want it. They asked if it could be formatted in a similar fashion to the new Output file. Even though the new Output file is most important to them, it turns out they still refer to the original downloaded file...

So, my problem is probablly that I'm not saving it. Yes???

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")
        Application.StatusBar = "Input:[" & Name & "] Output:[" & wbkOutput.Name & "]"
        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")
            FormatColumns wbkOutput.Worksheets(1).Rows(1)
            wbkOutput.Worksheets(1).Range("A1").Insert Shift:=xlToRight
            Range("A1").Select
            ActiveCell.FormulaR1C1 = "Download Date"
            Range("A1").Select
            Selection.WrapText = True
            Range("L1").Select
            Selection.WrapText = True
            Columns("A:A").ColumnWidth = 8.14
            FormatDownload wbkDownload.Worksheets(1).Range("A:L")
            wbkDownload.Save
        End If
        lngRowOut = lngRowOut + 1
        wbkDownload.Worksheets(1).Rows(lngRow).Copy wbkOutput.Worksheets(1).Range("a" & lngRowOut)
        FormatColumns wbkOutput.Worksheets(1).Rows(lngRowOut)
        wbkOutput.Worksheets(1).Range("A" & lngRowOut).Insert Shift:=xlToRight
        wbkOutput.Worksheets(1).Range("A" & lngRowOut) = GetDateFromFile(Name)
        wbkOutput.Close True
        lngRow = lngRow + 1
    Loop
    wbkDownload.Close False
End Sub

Display More

like this?

Oh yea. You also said, "formatting will not be retained with the csv file". ??? Can we change it to .xls ?

**Andy Pope** · Aug 15th 2004

If you are formatting the download file then you only need to do that at the end rather than multiple times within the loop.

The code below is just the last few lines from MyLoad subroutine.
The .Close argument is now TRUE in order to save the file.

But as I said before if you save as .csv then the formatting of the columns and cells will be lost. You will have to save the file as an excel file in order to retain te formatting.

Code

'
' snipped code from MyLoad
'


    FormatDownload wbkDownload.Worksheets(1)
    wbkDownload.Close True ' False
End Sub


Sub FormatDownload(RawData As Worksheet)
    With RawData
'        .Columns("A:A").ColumnWidth = 5
'        .Columns("B:B").ColumnWidth = 5
'        .Columns("C:C").ColumnWidth = 5
'        .Columns("D:D").ColumnWidth = 5
'        .Columns("E:E").ColumnWidth = 5
'        .Columns("F:F").ColumnWidth = 5
'        .Columns("G:G").ColumnWidth = 5
'        .Columns("H:H").ColumnWidth = 5
' condensed reference to columns A thru H        
        .Columns("A:H").ColumnWidth = 5
        
        .Cells.Select
        With Selection
            .HorizontalAlignment = xlCenter
        End With
    End With
End Sub

Display More

Eskkimo · Aug 15th 2004

Yes, yes, like usual, it is much simpler than I'd imagined. Thanks again.

Eva

Eskkimo · Aug 15th 2004

Hello Again,

One last (hopefully) little detail. The code that gets the date from the file grabs the date by starting with the eighth character counting from the left. The example I gave you was EMPIRE062920040913.csv. The name EMPIRE is not a constant. There are a few other names besides EMPIRE - - - I'm not sure what they are.

I was thinking we could get the first character by counting from the right instead. Is this possible. There will always be four random digits after the date.

Eva

**Andy Pope** · Aug 16th 2004

Hi Eva,

Replace the function with this new code.

Code

Function GetDateFromFile(Name As String) As String


'    EMPIRE062920040913.csv


    Dim intPos As Integer
    
    ' find file extension
    intPos = InStr(1, Name, ".csv", vbTextCompare)
    ' start from .csv position - 4 random digits + 8 date characters
    GetDateFromFile = Mid(Name, intPos - 12, 8)
    
End Function

Display More

Eskkimo · Aug 16th 2004

It's perfect!! Thanks Andy. I thought I saw something in Excel 2000 Bible that counted from the right... but it's probablly not the same cool function you're suggesting which allows us to save the dwnloaded file as an .xls

Your solutions are phenomenal and your time and knowledge are forever appraciated.

With much thanks,
Eva

Eskkimo · Aug 22nd 2004

Hello,

All is well over here with this high powered program. I was asked to add a line to the top of the newly formated download file and it looks like my code is working pretty well. It looks like this

Code

wbkOutput.Close True
        lngRow = lngRow + 1
    Loop
    FormatDownload wbkDownload.Worksheets(1)
    wbkDownload.Worksheets(1).Rows(1).Insert
    Range("A1").Select
    ActiveCell.FormulaR1C1 = GetDateFromFile(Name)
    wbkDownload.Close True ' False
End Sub

This is the very end of the MyLoad Subroutine. If there is a simpler way to insert a line let me know.

I'm also wondering if this newly formated workbook can be saved automatically instead of requiring us to choose it's file type and saving (two clicks that were not required before).

Eskkimo · Aug 23rd 2004

Something else that is not clear - how did you get the program to create the button we push (initially labeled "Eskkimo"). I'm sure it's something simple and I think there was a reference to it in a book... but there is nothing in the code that creates it. it's a mystery to me.

**Andy Pope** · Aug 24th 2004

Hi Eva,

Have a look at the .SaveAs method.

Code

wbkDownload.Worksheets(1).Rows(1).Insert 
wbkDownload.Worksheets(1).Range("A1").FormulaR1C1 = GetDateFromFile(Name) 
' check the help for more information
wbkDownload.SaveAs
wbkDownload.close

The button was created using the form toolbox. And a macro assigned to it.

Create Workbook and move data

Participate now!

Share