Macro works, then doesn't. Why?

[GTS]

Hello,

Below is a macro which largely came from a sample CD provided with a book I bought. Programming this code would have been beyond me.

The macro is in a file which I save into the same folder that my estimate files are in. There are usually 5 to 30 estimate files.

When I run this macro, it ripples thru all the files and sets a gross margin value. (Reads in the file list according to a couple criteria, opens the file, sets the value, saves and closes the file.)

For some reason, it will work fine when I first create the "setting" file (I'll call it) and I can continue to use it over and over, but then, for some reason, it will stop working. I mean, it runs, but doesn't do anything. No files open etc. No errors result.

When I rem'd out the "On error resume next" I got a message that it could not find the file. But the filename presented was 100% correct. In stepping thru the macro, I could see that it did execute the While strFilename... loop the proper number of times (if that helps).

Is something not getting flushed / initialized / re-initialized... ? I'm lost.

Sub Set_Gross_Margin()
 
    Dim dblPct As Double
    Dim strPath As String, strPrj As String, strFilename As String
    Dim wbkCurr As Workbook
 
    Dim Repsonse As VbMsgBoxResult
    Response = MsgBox("This Macro will apply the GROSS MARGIN value to" & vbCrLf & _
    "all files within the folder that match the criteria." & vbCrLf & _
    "It is recommended that ALL files are SAVED and CLOSED first!" & vbCrLf & _
    " " & vbCrLf & _
    "Do you want to run the Macro?", _
    vbYesNo + vbInformation + vbDefaultButton2, "Apply GROSS MARGIN value")
 
    If Response = vbNo Then Exit Sub
 
    Application.Calculate
 
    dblPct = Range("GM_TGT_INPUT") 'Pick up the value for Gross Margin
    strPrj = "*" & Range("PRJ_NO") 'Pick up the Job or Quote number, just to help limit the files this macro will act on.
    strPath = ThisWorkbook.Path & "\" 'Pick up the Path and add the backslash.
 
    strFilename = Dir(strPath & strPrj & "*.xls*") 'Restricted to only Excel workbook files.
    'If no matches found, then exit the macro.
    If strFilename = "" Then
        MsgBox "No files found matching: " _
            & strPath & strPrj & "*.xls*"
        Exit Sub
    End If
 
    'Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error Resume Next
    While strFilename <> ""
        Set wbkCurr = Workbooks.Open(strFilename)
        If Not wbkCurr Is Nothing Then
            Range("PARA!GM_TGT").Value = dblPct
            wbkCurr.Close SaveChanges:=True
        End If
        strFilename = Dir()
    Wend
    Set wbkCurr = Nothing
    Application.EnableEvents = True
    'Application.ScreenUpdating = True
 
End Sub

Thanks in advance. (Using Excel 2003 on Windows XP.)

 

[shg]

Dir returns just the filename, not the path, so if the path isn't the current directory, you can't open the file with the filename alone.

Try this:

Sub Set_Gross_Margin()
    Dim dGM         As Double
    Dim sPath       As String
    Dim sProj       As String
    Dim sFile       As String
 
    If MsgBox(Prompt:="This Macro will apply the GROSS MARGIN value to" & vbLf & _
                      "all files within the folder that match the criteria." & vbLf & _
                      "It is recommended that ALL files are SAVED and CLOSED first!" & vbLf & " " & vbLf & _
                      "Do you want to run the Macro?", _
              Buttons:=vbYesNo + vbInformation + vbDefaultButton2, _
              Title:="Apply GROSS MARGIN value") = vbNo Then Exit Sub
 
    Application.Calculate
    dGM = Range("GM_TGT_INPUT")

    sProj = "*" & Range("PRJ_NO")
    sPath = ThisWorkbook.Path & "\"
    sFile = Dir(sPath & sProj & "*.xls*")
    
    If Len(sFile) = 0 Then
        MsgBox "No files found matching: " & sPath & sProj & "*.xls*"
        Exit Sub
    End If
 
    Application.EnableEvents = False

    Do
        With Workbooks.Open(sPath & sFile)
            Range("PARA!GM_TGT").Value = dGM
            .Close SaveChanges:=True
        End With
        sFile = Dir()
    Loop While Len(sFile)
 
    Application.EnableEvents = True
End Sub

 

[GTS]

shg,

Thank you very much for this.

I tried your version and it works fine.
Your explanation gave me a clue though.
I recalled that the original macro had the path in the Workbooks.Open line. I thought it was redundant. Now I know better!

I have a dozen macros like this one in the file (setting different things). So what I've done (since it was less work) is to simply edit the following line...

Set wbkCurr = Workbooks.Open(strFilename)

to this...

Set wbkCurr = Workbooks.Open(strPath & strFilename)

It appears to be working. I did this in a file where the macro was no longer working and after the edit, it did work.

Hopefully this is all I need to do. Otherwise, I will update all the macros to your version.

Thanks again.

GTS

 

[shg]

You're welcome, good luck.