need to automate a sheet re-organization

[MeowSayTongue]

Hello.

I download a spreadsheet workbook often online that is a DVD database.
I need to correct its structure and bring it into 2k7 form factor to
make my use of it practical.

It is located here:

http://www.hometheaterinfo.com/dvdlist.htm

The file link is: http://www.hometheaterinfo.com/download/dvdlist.zip

It is a 12.7 MB file. More unzipped. 2k3 format.

What I need to do is make a small macro that converts it to a 2k7
single worksheet file, and shift one column to the leftmost position.

I have been manually performing these tasks by manually saving the file
in the 2k7 format, then I cut and paste the column I want shifted in each
of the three worksheets labeled "a-f", "g-o", and "p-z".

The column I move is the ID column to the leftmost position, in all
three worksheets.

After moving the ID column, I then rename "atof" to "DVDs" and then
addendum the other two sections, creating a single, one worksheet flat
file database. I then delete the two original middle and end worksheets.

Are there not a few quick macro functions I could utilize to do this?

Meow

 

[Joel]

What unzip utility are you using on your PC. the solution depends on which
tool you are usings. I have WinRar and found a VBA macro on the web that
will unzip the file into a folder on the PC.

The macro will have to perform 3 steps
1) Download the file onto the PC
2) Unzip the file
3) Perform your changes

I just want to know what folders you are using now on your PC and if you
were using WinRar or some other unzip utility.

 

[MeowSayTongue]

I do use WinRar, and it is tied to the zip extension.

I found that it will not auto-magically save as a 2k7 file, as it tries
to retain compatibility. So I open a blank workbook first, and have to
copy the sheets into that workbook, to get a pure 2k7 format file. Unless
I am missing some technique there as well.

Which is entirely possible.

Thanks.

Meow

 

[Joel]

this task is pretty simple if you just want to modify the XLS file. but if
you want to download and unziop the file automatically it is more
complicated. I put the downloaded and unzip file in you document and Setting
folder. Just start the code and DO NOTHING. the download portion of the
code needs to use the active window so don't do anythin on your PC until the
file starts to download and the check box to close the download window is
checked.

Sub unzipcode()


FName = "dvdlist.zip"
'URL = "http://www.hometheaterinfo.com/dvdlist.htm"
URL = "http://www.hometheaterinfo.com/download/"
'http://www.hometheaterinfo.com/download/dvdlist.zip
FName = "dvdlist.zip"
AppData = Environ("APPDATA")
Filename = AppData & "\" & FName

FNameXLS = FName
'remove extension
FNameXLS = Left(FName, InStrRev(FName, "."))
FNameXLS = AppData & "\" & FNameXLS & "xls"

'remove ZIP file before downloading so message
'do you want to remove file doesn't show up
'in download window
FileFound = Dir(Filename)
If FileFound <> "" Then
Kill Filename
End If


Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

'get web page
IE.Navigate2 URL & FName
'wait 5 seconds
Application.Wait (Now + TimeValue("0:00:05"))



'send ALT - S to save file
ActiveWindow.Application.SendKeys ("%S"), True
'select the filename box
ActiveWindow.Application.SendKeys ("%n"), True
ActiveWindow.Application.SendKeys (Filename), True

'press save button to start downloading
ActiveWindow.Application.SendKeys ("%S"), True
'wait 5 seconds before click button below
Application.Wait (Now + TimeValue("0:00:05"))
'press button to closedownload file when complete
ActiveWindow.Application.SendKeys ("%C"), True

'wait untiule file is downloaded
Do
Downloadfile = Dir(Filename)

DoEvents

Loop While Downloadfile = ""

'remove xls file if exists before opening new one
FileFound = Dir(FNameXLS)
If FileFound <> "" Then
Kill FNameXLS
End If

WinRarPath = "C:\Program Files\WinRar\"
CommandStr = _
"""" & WinRarPath & "WinRar.exe"" e" & _
" """ & Filename & """" & _
" *.xls """ & AppData & """"
Range("A1") = CommandStr

RarIt = Shell(CommandStr, vbNormalFocus)

'remove read only attribute
CommandStr = "Attrib -R " & FNameXL

RemoveReadOnly = Shell(CommandStr, vbNormalFocus)

'wait 5 seconds
Application.Wait (Now + TimeValue("0:00:05"))

Set bk = Workbooks.Open(FNameXLS)
With bk
'combine sheets 2 and 3 to sheet 1
For ShtCount = 2 To 3
LastRow = .Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
LastRow = .Sheets(ShtCount).Range("A" & Rows.Count).End(xlUp).Row
'copy data to sheet 1
.Sheets(ShtCount).Rows("1:" & LastRow).Copy _
Destination:=.Sheets(1).Rows(NewRow)
Next

Application.DisplayAlerts = False
.Sheets(3).Delete
.Sheets(2).Delete
Application.DisplayAlerts = True

With .Sheets(1)
'find ID column
Set C = .Rows(1).Find(what:="ID", _
LookIn:=xlValues, lookat:=xlWhole, _
MatchCase:=False)
C.EntireColumn.Cut
.Columns("A").Insert
.Name = "DVDs"
End With
.Close savechanges:=True
End With

End Sub

 

[MeowSayTongue]

Wow, thanks, Joel. That looks awesome. I would only need to edit the
location of winrar call.

Does that take the conversion into account? Because this file will not
go past a 65k row sheet, and adding those together has to take place on
the new Excel 2007 type sheet. type .xlsx

So, would I not need to add a "workbooks.new" (or the like)routine in
there and "import" the 2k7 .xls sheets to it before the last routine,
which would then be working with the .xlsx file as well at that point?

Thanks again, that is awesome, and each time I get help, I gain a bit
more knowledge about modern paradigms and structures and syntaxes, as
compared to my 286 Paradox relational database days, which only lasted a
few years and was a long time ago.


Meow

 

[Joel]

I tested the code with 2003 and had to remove some of the rows to fully test
the code. I guess you just need to do a workboook saveas on the as a xlsx
file after opening the xls workbook. Youcould use the environ("Programfiles)
when you are getting the Winrar file so the code will work on vista as well
as XP.
I tried to use FTP to get the ZIP file from the web but the server wouldn't
allow the anonymous accout to login into the server. I didn't like the fact
I had to work with the active window and SENDKEY to get the file.

 

[MeowSayTongue]

Here is my conversion code.

There seems to be a problem when selecting entire rows from a 2k3 sheet
and attempting to paste them into a 2k7 sheet. I have tried all methods,
as in 'values only', etc. It still pukes. I can only select the data
block itself and paste it, so I would need a code segment that always
finds the last entry in the sheet, and only places that block on the copy
cache. Then, it pastes just fine.

I did not place any of your zip file management into my routine.

I want to make an "import new files" routine for that one, and a
"Convert" routine as I have here, for the conversion and final save.

It adds one additional button to the list, but lets the user bypass the
DL if he already has the file on hand. Unless a user query could be
added at that point to convert the existing file or grab the new one
first.

My code:




Sub DVD_List_Converter_for_Office_2007_Use()
'
' DVD_List_Converter_for_Office_2007_Use Macro
'
' Converts the three sheet, Office 97/2003 workbook into a
' single sheet, Office 2007 workbook for better use as a
' large flat file database.
'
'
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Temp\dvdlist\DVDList1.xlsx",
FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DVDs"
Workbooks.Open Filename:="D:\Temp\dvdlist\dvdlist.xls"
Sheets("a-f").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("DVDList1.xlsx").Activate
ActiveSheet.Paste
Windows("dvdlist.xls").Activate
Sheets("g-o").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("DVDList1.xlsx").Activate
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A58887").Select
ActiveSheet.Paste
Range("A58888").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A115010").Select
Windows("dvdlist.xls").Activate
Sheets("p-z").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("DVDList1.xlsx").Activate
ActiveSheet.Paste
Columns("N:N").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
End Sub

Meow

 

[MeowSayTongue]

I tested the code with 2003 and had to remove some of the rows to fully test
the code. I guess you just need to do a workboook saveas on the as a xlsx
file after opening the xls workbook.

That never worked for me either as it saves as a compatibility file
mode.

I have to explicitly add a new workbook, and save that as an xlsx file,
and then mark and paste the other sheets in. I have to mark and paste
only the data as well, because marking the entire sheet causes the paste
to fail.

One problem will be that that block size will vary from day to day.
I manually move to the end of the sheet data in the macro, but that would
nee to be dynamic.

currently I start at A1 and do a Ctrl-Shift-End to mark only the data
(plus one row oddly enough).

That allows pasting. Making the entire sheet does not.

I could copy all three sheets over, and then do the stack up there. That
might work.

Thanks for all your help. I wrote another post showing what I came up
with.

Meow

 

[MeowSayTongue]

This one is much better and more compact, not that that matters.


Sub DVD_List_Converter_for_Office_2007_Use()
'
' DVD_List_Converter_for_Office_2007_Use Macro
' Converts three sheet, Office 97/2003 workbook into a single sheet,
Office 2007 workbook for better use as a large flat file database
'
'
Workbooks.Add
ChDir "D:\Temp\dvdlist"
ActiveWorkbook.SaveAs Filename:="D:\Temp\dvdlist\DVDList1.xlsx",
FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Workbooks.Open Filename:="D:\Temp\dvdlist\dvdlist.xls"
Sheets(Array("a-f", "g-o", "p-z")).Select
Sheets("a-f").Activate
Sheets(Array("a-f", "g-o", "p-z")).Copy
Before:=Workbooks("DVDList1.xlsx"). _
Sheets(2)
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Sheet1"
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Sheets("a-f").Select
Sheets("a-f").Name = "DVDs"
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A58887").Select
Sheets("g-o").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Sheets("DVDs").Select
Selection.Insert Shift:=xlDown
Range("A58887").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A115010").Select
Sheets("p-z").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Sheets("DVDs").Select
ActiveSheet.Paste
Sheets("g-o").Select
ActiveWindow.SelectedSheets.Delete
Sheets("p-z").Select
ActiveWindow.SelectedSheets.Delete
Columns("N:N").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
ActiveWorkbook.Save
Windows("dvdlist.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
ActiveWindow.Close
ActiveWindow.Close
End Sub


Meow

 

[Joel]

You will see this code twice because I posted at moth MS and thecodecage.
thecodecage just started a new poclicy of not posting until somebody at
thecodecage as reviewed the posting. thsi will slow down the postings. MS
just waits about 5 minutes before a postijng is updatedc but the MS site
isn't maintained and it often broken for days before MS repairs the site.

Read my other comments from the code cage when they show up.


Sub DVD_List_Converter_for_Office_2007_Use()
'
' DVD_List_Converter_for_Office_2007_Use Macro
'
' Converts the three sheet, Office 97/2003 workbook into a
' single sheet, Office 2007 workbook for better use as a
' large flat file database.
'
'
FName = "dvdlist.zip"
AppData = Environ("APPDATA")
Filename = AppData & "\" & FName

FNameXLS = FName
'remove extension
FNameXLS = Left(FName, InStrRev(FName, "."))
FNameXLS = AppData & "\" & FNameXLS & "xls"


Set bk = Workbooks.Open(FNameXLS)
Set Newbk = Workbooks.Add(template:=xlWBATWorksheet)
Newbk.SaveAs Filename:="D:\Temp\dvdlist\DVDList1.xlsx", _
FileFormat:=xlOpenXMLWorkbook
Set NewSht = Newbk.Sheets(1)
NewSht.Name = "DVDs"
With bk
'combine sheets 2 and 3 to sheet 1
For ShtCount = 1 To 3
LastRow = NewSht.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
LastRow = .Sheets(ShtCount).Range("A" & Rows.Count).End(xlUp).Row
'copy data to sheet 1
.Sheets(ShtCount).Rows("1:" & LastRow).Copy _
Destination:=NewSht.Rows(NewRow)
Next

With NewSht
'find ID column
Set C = .Rows(1).Find(what:="ID", _
LookIn:=xlValues, lookat:=xlWhole, _
MatchCase:=False)
C.EntireColumn.Cut
.Columns("A").Insert

End With

bk.Close savechanges:=False
Newbk.Save
End With

End Sub

 

[MeowSayTongue]

See my comment amidst your code, below...

You will see this code twice because I posted at moth MS and thecodecage.
thecodecage just started a new poclicy of not posting until somebody at
thecodecage as reviewed the posting. thsi will slow down the postings. MS
just waits about 5 minutes before a postijng is updatedc but the MS site
isn't maintained and it often broken for days before MS repairs the site.

Read my other comments from the code cage when they show up.


Sub DVD_List_Converter_for_Office_2007_Use()
'
' DVD_List_Converter_for_Office_2007_Use Macro
'
' Converts the three sheet, Office 97/2003 workbook into a
' single sheet, Office 2007 workbook for better use as a
' large flat file database.
'
'
FName = "dvdlist.zip"
AppData = Environ("APPDATA")
Filename = AppData & "\" & FName

FNameXLS = FName
'remove extension
FNameXLS = Left(FName, InStrRev(FName, "."))
FNameXLS = AppData & "\" & FNameXLS & "xls"

I think I need to insert the WinRar extract code segment in here
or the above FName should directly be the .xls file name.

Set bk = Workbooks.Open(FNameXLS)
Set Newbk = Workbooks.Add(template:=xlWBATWorksheet)
Newbk.SaveAs Filename:="D:\Temp\dvdlist\DVDList1.xlsx", _
FileFormat:=xlOpenXMLWorkbook
Set NewSht = Newbk.Sheets(1)
NewSht.Name = "DVDs"
With bk
'combine sheets 2 and 3 to sheet 1
For ShtCount = 1 To 3
LastRow = NewSht.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
LastRow = .Sheets(ShtCount).Range("A" & Rows.Count).End(xlUp).Row
'copy data to sheet 1
.Sheets(ShtCount).Rows("1:" & LastRow).Copy _
Destination:=NewSht.Rows(NewRow)
Next

With NewSht
'find ID column
Set C = .Rows(1).Find(what:="ID", _
LookIn:=xlValues, lookat:=xlWhole, _
MatchCase:=False)
C.EntireColumn.Cut
.Columns("A").Insert

End With

bk.Close savechanges:=False
Newbk.Save
End With

End Sub

I will try this and see if it works.

thanks again.

Meow

 

[Simon Lloyd]

Just a note slightly off topic, thecodecage doesn't have a pos
moderating policy, the post was sent to moderation due to some keyword
that appear in our anti spam program, lately we have experienced man
chinese originated posts all to do with D...V...D software, it i
unfortunate that a few legitimate ones get caught in it

See my comment amidst your code, below..


On Sat, 21 Nov 2009 16:52:03 -0800, Joe
<[email protected]
wrote



I think I need to insert the WinRar extract code segment in her
or the above FName should directly be the .xls file name







I will try this and see if it works

thanks again

Meo

--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)

 

[MeowSayTongue]

I tested the code with 2003 and had to remove some of the rows to fully test
the code.

This is impossible to do in 2003.

The row limit is the reason why the list is across three sheets.

That is the whole purpose.

Also, the direct link to grab the file is there, and in Windows 7
there are no hot key key presses you can make to save the file, so the
timeouts could be increased so I can manually save the file, and then
step right into the extract. So no keypress passes should be required. Or
simply leave the timeout long enough to allow the user to complete the
save, then continue in the code.

THEN it needs the conversion, from within 2007, because of the row
limit.

That is why I performed the new "add" and then copy all three sheets to
it, and close the original, which requires no change save feedback
dialogs. THEN, I delete sheet 1 and 2 and rename a-f as DVDs, then
remove row 1 from the two latter sheets, then I can cut and paste their
data. This succeeds, because the 'new' 'add' I did created a full xlsx
file.

I have tried your method of performing the save as, an xlsx sheet, and
it does acquire the file extension, but it also refuses to give up the
compatibility mode attribute, which brings back the 65535 row limit
issue. So, if there is a way in the VB script to remove the
compatibility mode attribute from the saved as xlsx format file, the cut
and paste operations would work and all the operations could take place
within the single extracted file.

I think the save as works, but all I have to do is close the file and
re-open it after the save as. During the session, it retains the
compatibility mode, which messes up the conversion.


Meow

 

[MeowSayTongue]

Well, manually pass it through then, no?

I cannot see the comments he mentioned here because he only posted them
there.

Unbelievable, BTW. Nothing about it in the topic, which is the only
place you should be looking. Just block all china posts until THEY
police their own.

Sad that we cannot simply to that to get these lame governments to
properly police their net subscribers.

Meow

 

[joel]

I suspect the workbook you are using that contains the macro may stil b
in 2003 format. I would create a new workbook. then copy the macro
from you old workbook to the new workbook. Then retry the code.

Which verion of IE explorer are you using. The shortcuts keys wold b
part of the IE and you may need to select in tyour IE explorer th
compatibility mode so the web browser works with older version o
webpages.

The Sendky method I used true which is suppose to wait for th
application to process the key command before continueing. I only ha
problems with winXP, 2003, IE version 8 with the box to close th
download box when the download was complete. I Added a 5 second time
before sending the key

 

[MeowSayTongue]

I suspect the workbook you are using that contains the macro may stil be
in 2003 format. I would create a new workbook.

No. The macro is in my personal space, not in ANY workbook.

then copy the macros
from you old workbook to the new workbook. Then retry the code.

Which verion of IE explorer are you using. The shortcuts keys wold be
part of the IE

Wrong again. The save dialogs are not part of IE, but part of the
desktop GUI. There *may* be a place where I can turn such hotkeys back
on, but they are not on by default in Windows 7 GUI dialogs.

and you may need to select in tyour IE explorer the
compatibility mode so the web browser works with older version of
webpages.

I can DL the file directly from the URL I have, and the code you
provided shows links to the page and multiple URLs. I have direct links
for the DLs. So I have no problem with my IE nor the page I am hitting.

The Sendky method I used true which is suppose to wait for the
application to process the key command before continueing.

It relies on hotkey functions which must be in place, and are not.

I only had
problems with winXP, 2003, IE version 8 with the box to close the
download box when the download was complete.

The do until isn't needed either. It is a five second DL here, and I
can allocate ten seconds for the wait, and it will already be here.

I Added a 5 second times
before sending the key.

The key sent has no function in the save dialog shown.

Meow