• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro debugging

F

ferocious12

Member
Hi All,

I have following macro that extract worksheet "Data entry" from all the excel files saved at a particular location and combine them in one workbook. It was working fine until last month but this month my excel keep crashing when I run the macro and it doesn't do the job.

Can you see any mistake in it. The debugging point me to "SFname" in the following code but don't know:

Code: 
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Variant

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False






    
    sPath = InputBox("Enter a full path to workbooks")
    ChDir sPath
    sFname = "*"
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    wSht = "Data entry"
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        Windows(sFname).Activate
        Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
   Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    
End Sub
 
Hi !​
​
As per forum rules and as we are not mind readers, explain at least which error you met and which codeline raises this error …​
If no mod was made to this code should I guess it's just a context error often located between the screen and the chair ?​
​
 
I think you need to modify your code as follows:

Code: 
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Worksheet
    Dim sSht2F As String
    Dim sSheet As String
    '
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    '
    sPath = InputBox("Enter a full path to workbooks")
    sSht2F = InputBox("Enter the phrase you want to search")
    ChDir sPath
    sFname = "*"
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    Excel.Application.UserControl = False
    Excel.Application.EnableEvents = False
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        For Each wSht In wBk.Worksheets
            If wBk.Worksheets.Count > 5 Then Exit For
            sSheet = wSht.Name
            If InStrRev(sSheet, sSht2F, -1, vbTextCompare) <> 0 Then
                Windows(sFname).Activate
                Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
                Excel.Application.StatusBar = "Found [" & sSht2F & "} in the worksheet [" & sSheet & " in the Workbook [" & wBk.Name & "] !!"
                wBk.Close False
                sFname = Dir()
            Else
            Excel.Application.StatusBar = "Did not find [" & sSht2F & "} in the worksheet [" & sSheet & " in the Workbook [" & wBk.Name & "] !!"
            End If
        Next wSht
    Loop
    Excel.Application.UserControl = True
    Excel.Application.EnableEvents = True
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


CombineSheets_Exit:

    On Error GoTo 0
    Exit Sub

CombineSheets_Error:

    MsgBox "Error " & Err.Number & " on Line # " & Erl & " (" & Err.Description & ") in procedure CombineSheets of Module bas_CombineSheets"
    GoTo CombineSheets_Exit

End Sub


That should do the trick!! Remember to comment out the line that says If wBk.Worksheets.Count > 5 Then Exit For
if your worksheet may be found at a location that is likely to go above that limit!! ENJOY!!
 
Last edited:
Marc L said:
Hi !​
​
As per forum rules and as we are not mind readers, explain at least which error you met and which codeline raises this error …​
If no mod was made to this code should I guess it's just a context error often located between the screen and the chair ?​
​
Click to expand...
Apologies. Let me explain. I have consolidate numbers from 13 companies and prepare a summary. Above code performs one the tasks as follows:

1. It asks for location of the 13 excel files (one for each company)
2. open each file and copy worksheet named "Data entry" and paste it to summary workbook


It was working all fine until last month. Noe this month the problem is:

1. the code successfully open and copy the worksheet " Data entry" and paste it to summary workbook. However, excel crashes when it comes to 7th file. Loop is failing here. Don't know why?

I ran the same macro for files for last month working all right.
 
vbacoder1962 said:
I think you need to modify your code as follows:

Code: 
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Worksheet
    Dim sSht2F As String
    Dim sSheet As String
    '
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    '
    sPath = InputBox("Enter a full path to workbooks")
    sSht2F = InputBox("Enter the phrase you want to search")
    ChDir sPath
    sFname = "*"
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    Excel.Application.UserControl = False
    Excel.Application.EnableEvents = False
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        For Each wSht In wBk.Worksheets
            If wBk.Worksheets.Count > 5 Then Exit For
            sSheet = wSht.Name
            If InStrRev(sSheet, sSht2F, -1, vbTextCompare) <> 0 Then
                Windows(sFname).Activate
                Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
                Excel.Application.StatusBar = "Found [" & sSht2F & "} in the worksheet [" & sSheet & " in the Workbook [" & wBk.Name & "] !!"
                wBk.Close False
                sFname = Dir()
            Else
            Excel.Application.StatusBar = "Did not find [" & sSht2F & "} in the worksheet [" & sSheet & " in the Workbook [" & wBk.Name & "] !!"
            End If
        Next wSht
    Loop
    Excel.Application.UserControl = True
    Excel.Application.EnableEvents = True
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


CombineSheets_Exit:

    On Error GoTo 0
    Exit Sub

CombineSheets_Error:

    MsgBox "Error " & Err.Number & " on Line # " & Erl & " (" & Err.Description & ") in procedure CombineSheets of Module bas_CombineSheets"
    GoTo CombineSheets_Exit

End Sub


That should do the trick!! Remember to comment out the line that says If wBk.Worksheets.Count > 5 Then Exit For
if your worksheet may be found at a location that is likely to go above that limit!! ENJOY!!
Click to expand...

Many thanks. but doesn't work. What I need to do with this line: If wBk.Worksheets.Count > 5 Then Exit For
 
You've written (blue text):
the excel files saved at a particular location and combine them in one workbook.

- No one else is using the files
>> I have consolidate numbers from 13 companies and prepare a summary.
>> It asks for location of the 13 excel files (one for each company)
So why there are 13 files, if only You're using those 14 files?

he data is saved on my desktop so don't see an issue
>> sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
'desktop' ... something won't match with Your comments ...
Good luck
 
Thanks. My comments in red


vletm said:
You've written (blue text):
the excel files saved at a particular location and combine them in one workbook.

- No one else is using the files
>> I have consolidate numbers from 13 companies and prepare a summary.
>> It asks for location of the 13 excel files (one for each company)
So why there are 13 files, if only You're using those 14 files?

I receive individual company results from all 13 companies and need to consolidate those

he data is saved on my desktop so don't see an issue
>> sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
'desktop' ... something won't match with Your comments ...

Files are saved on a folder on desktop. When I tried to run the macro on another laptop, I got error on above line SFname =.................. do I need to fix this do you think?
Good luck
Click to expand...
 
ferocious12
You would write exact detail as those are ... not as You ... think.

Why You should try to write correct path?
sPath = InputBox("Enter a full path to workbooks")
... why You do not read it or something else?
especially You do not have any error handling
... eg On Error Resume Next
... if any 'typo' or so then it's at once 'Game Over!'

sFname = "*"
... what would the 1st sFname's value?
... what are next sFname's values?
... ... do not write that it's something
... have You checked those one-by-one?
... are those always correct?

Why do You 'activate' something?
... You could copy that sheet without activating.
... I won't use ThisWorkbook
... ... I would use variable instead of that ... if something mystery, then what would be then ThisWorkbook ?

Finally
... have You run that step-by-step with any laptop which You're using it?
... ... and track err.number ?
 
You must log in or register to reply here.
Back
Top