knowledgbase item problem - in excel 97

**Immatoity** · 02-02-2006, 01:01 PM

Hi

I have successfully run the "combine" routine in excel 2002 but when I try this at work on excel 97 it fails on the line " WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

any idea why? Would love this to work "at work" as have loads of files to merge into one
code below
[VBA]Option Explicit

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
pszpath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long

Public Type BrowseInfo
hOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Function GetDirectory(Optional msg) As String
On Error Resume Next
Dim bInfo As BrowseInfo
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Root folder = Desktop
bInfo.pIDLRoot = 0&

'Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Please select the folder of the excel files to copy."
Else
bInfo.lpszTitle = msg
End If

'Type of directory to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String

ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = GetDirectory
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Wkb = Nothing
Set LastCell = Nothing
End Sub
[/VBA]
cheers

**Ken Puls** · 02-02-2006, 04:25 PM

Hi there,

Are you sure nothing else is different? The following works just fine in Excel 97, so I don't think it is a version issue:

[vba]Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End Sub[/vba]

**tpoynton** · 02-02-2006, 04:33 PM

seems like there is a problem with the if statement here:

[vba]
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
[/vba]

should the else be there?

**Ken Puls** · 02-02-2006, 04:39 PM

Originally Posted by tpoynton

should the else be there?

I assumed that this came straight out of the KB as an "If True Then do nothing Else copy the sheet.

Worth a look though it it's part that you modified.

**Ken Puls** · 02-02-2006, 04:43 PM

FYI, original entry by Malik641: http://vbaexpress.com/kb/getarticle.php?kb_id=829

The IF statement was constructed that way in the KB.

**tpoynton** · 02-02-2006, 04:59 PM

I just checked that too. I never think to have an if statement do nothing, so it looked strange to me

the kb was tested with excel 2003 - given its placement in the code, it just makes it seem suspect to me...i'm still learning!

**Ken Puls** · 02-02-2006, 05:15 PM

Tim, we're all still learning!

I code some of my IF statements like this, just so it's obvious:
[Vba]If lValue = 10 Then
'do nothing
Else
Activecell.Interior.ColorIndex = 35
End If[/vba]

Or whatever. It's a nonsense routine, but you get the point. It's commented in my code to tell someone else "I really meant to do nothing here". I know I could code it otherwise, but it reads nicely to me.

**tpoynton** · 02-02-2006, 05:27 PM

thanks Ken - "do nothing" does read better than "if not" statements, which have always seemed strange too...THANKS, tim

**Immatoity** · 02-03-2006, 06:02 AM

hi

sorry for being thick...what do I need to do in Excel 97 to get this to work?

PS Some of the files only have one tab, not sure thats important?

**tpoynton** · 02-03-2006, 06:57 AM

I think this is a longshot, but...

[vba]If LastCell.Value <> "" And LastCell.Address <> Range("$A$1").Address Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If[/vba]

**Immatoity** · 02-03-2006, 08:59 AM

hi..cheers for that but it still fails

**tpoynton** · 02-03-2006, 09:10 AM

In Ken's example above that works on Excel 97, he set WS to Activesheet - perhaps you need to add that line as the first part of your your loop through the sheets?

[vba]
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each WS In Wkb.Worksheets
Set WS = Activesheet
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS [/vba]

untested with any version of excel...

**Ken Puls** · 02-03-2006, 11:41 AM

Hi guys,

Tim, if I were going to set something to activesheet, I'd insert a new variable (maybe wsTemp), but not set WS to something else when it's being used to control the loop. I don't think it would have any effect in this case, but it seems a dangerous practice to me.

Immatoity, sorry for the breakaway from your question,

I jsut tried running the code you posted above in Excel 97 and while I did come up with an issue, it wasn't on that line. In one of the files I merged, the "LastCell" was a merged cell* so it failed on this line:

[vba]If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then[/vba]

A quick change to LastCell.Text = "" worked.

Basically, I think your issue is with a workbook, or your implementation, not the code itself. I even tested it on workbooks with only one sheet, and it worked fine.

Do you get any workbooks copied over, or does it fail immediately?

*Re Merged Cells. I created this workbook a long time ago, and have not got around to fixing it. As anyone who knows me will tell you, I HATE merged cells, as they do nothing but cause problems. Avoid them at all costs!

**tpoynton** · 02-03-2006, 11:52 AM

Thanks Ken - That is a bad idea...I'm full of bad practices that need correcting!

**Immatoity** · 02-07-2006, 06:08 AM

hi

just tried it again with a directory with 3 files in.. I just created the files and simply put on letter on sheet 1 of each (ie book 1.xls had letter a in sheet 1, book 2 had letter b etc)

its still fails on the line
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

the error message is "Runtime error 1004 Method 'Copy' of Object'_Worksheet' Failed

well confused now

**Ken Puls** · 02-07-2006, 09:29 AM

Where are you running the code from? Is it in your Personal.xls file, or another (visible) workbook?

**Immatoity** · 02-09-2006, 06:02 AM

yes it is in my personal.xls file, I open a new excel workbook and try to run it

**Ken Puls** · 02-09-2006, 09:21 AM

Hi there,

With the code in personal.xls, this line:
[vba] ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)[/vba]

Will copy the data into your personal.xls workbook, not the active workbook. As personal.xls is by default a hidden workbook, you wouldn't be able to see it, even if it was successful.

Try dropping the code into a regular (blank) workbook and run it from there. I think you'll get better results.

HTH,

**Immatoity** · 02-09-2006, 09:57 AM

works a treat cheers for that!!

Thread: knowledgbase item problem - in excel 97

Thread Tools

Display

knowledgbase item problem - in excel 97

Posting Permissions