CODEWITHSUNDEEP
excelvbamacos
ViaxCo
ViaxCo

Reputation: 234

VBA Macro does nothing after run, gives no errors (macos)

This is my first question on this platform, so please forgive any mistake I might make. I have a couple of excel workbooks that I would like to make multiple exact changes to exact sheets and exact cells in all of them, but they are way too many to do individually. I recorded all the changes I am to make in a macro using one of the workbooks;

Sub Macro1()

Range("W4:X4").Select
ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
Range("J33:M33").Select
ActiveCell.FormulaR1C1 = "Hz"
Range("B33:I33").Select
ActiveCell.FormulaR1C1 = "DETAILS"
Range("R34:X34").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Range("R35:X35").Select
Selection.Cut
Range("R34").Select
ActiveSheet.Paste
Range("K68:L123").Select
Selection.Delete Shift:=xlToLeft
Range("K68:L68").Select
ActiveCell.FormulaR1C1 = "UNITS ON BAR"
Range("V178").Select
ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
Range("V179:V182").Select

End Sub

I ran this macro in another different unmodified workbook and it worked perfectly. I'm quite new to using VBA, but I was able to find a block of code online that makes a change in multiple excel files in a specified directory;

Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet

' Change directory path as desired
dirName = "c:\myfiles\"

MyPath = dirName & "*.xlsx"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile

Do While MyFile <> ""
    If Len(MyFile) = 0 Then Exit Do 

    Workbooks.Open MyFile

    With ActiveWorkbook
        For Each wks In .Worksheets
            ' Specify the change to make
            wks.Range("A1").Value = "A1 Changed"
        Next
    End With

    ActiveWorkbook.Close SaveChanges:=True

    MyFile = Dir
    If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub

I edited it to fit my needs like so;

Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
Set wks = ActiveWorkbook.Worksheets("SHEET X")

' Change directory path as desired
dirName = "/Users/Account/Desktop/Directory 1/Directory 2/"

MyPath = dirName & "*.xls"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile

Do While MyFile <> ""
    If Len(MyFile) = 0 Then Exit Do

    Workbooks.Open MyFile

    With ActiveWorkbook
        For Each wks In ActiveWorkbook.Worksheets
            ' Specify the change to make
            wks.Range("W4:X4").Select
            ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
            wks.Range("J33:M33").Select
            ActiveCell.FormulaR1C1 = "Hz"
            wks.Range("B33:I33").Select
            ActiveCell.FormulaR1C1 = "DETAILS"
            wks.Range("R34:X34").Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            wks.Range("R35:X35").Select
            Selection.Cut
            wks.Range("R34").Select
            ActiveSheet.Paste
            wks.Range("K68:L123").Select
            Selection.Delete Shift:=xlToLeft
            wks.Range("K68:L68").Select
            ActiveCell.FormulaR1C1 = "UNITS ON BAR"
            wks.Range("V178").Select
            ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
            wks.Range("V179:V182").Select
        Next
    End With

    ActiveWorkbook.Close SaveChanges:=True

    MyFile = Dir
    If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub

I ran it and it did nothing and returned no error. I'm really at my wits' end here and I would really appreciate any help. P.S I'm a mac user

Upvotes: 1

Views: 3073

Answers (2)

ViaxCo
ViaxCo

Reputation: 234

Well, 120 simultaneous open tabs(no joke, I counted 😂) and two sleepless nights later, I finally found a solution. NOTE: THIS WORKS ON MAC ONLY, apparently I think Dir doesn't work on Mac, thanks to @Jeeped for pointing that out, so for other Mac users with my issue, this is what I did:

Option Explicit
'Important: this Dim line must be at the top of your module
Dim dirName As String

Sub ChangeFiles()
Dim MySplit As Variant
Dim FileIndirName As Long
Dim wks As Worksheet

'Clear dirName to be sure that it not return old info if no files are found
dirName = ""

Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=1, FileFilterOption:=0, FileNameFilterStr:="SearchString")

If dirName <> "" Then
    With Application
        .ScreenUpdating = False
    End With

    MySplit = Split(dirName, Chr(13))
    For FileIndirName = LBound(MySplit) To UBound(MySplit)

    Workbooks.Open (MySplit(FileIndirName))
    Set wks = ActiveWorkbook.Worksheets("SHEET X")

    With wks
       .Range("W4:X4") = "OFF -PEAK GEM(MW)"
        .Range("J33:M33") = "Hz"
        .Range("B33:I33") = "DETAILS"
        .Range("R34:X34").EntireRow.Insert Shift:=xlShiftDown
        .Range("R35:X35").Cut Destination:=Range("R34")
        .Range("K68:L123").Delete Shift:=xlToLeft
        .Range("K68:L68") = "UNITS ON BAR"
        .Range("V178") = "EXPECTED RESERVE"
    End With

    ActiveWorkbook.Close SaveChanges:=True

    Next FileIndirName
        With Application
            .ScreenUpdating = True
        End With
Else
    MsgBox "Sorry no files that match your criteria, A 0 files result can be due to Apple sandboxing: Try using the Browse button to re-select the folder."
    With Application
        .ScreenUpdating = True
    End With
End If
MsgBox "Done!"
End Sub

'*******Function that do all the work that will be called by the macro*********

Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, _
                                          FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)
Dim ScriptToRun As String
Dim folderPath As String
Dim FileNameFilter As String
Dim Extensions As String

On Error Resume Next
folderPath = MacScript("choose folder as string")
If folderPath = "" Then Exit Function
On Error GoTo 0

Select Case ExtChoice
Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)"  'xls, xlsx , xlsm, xlsb
Case 1: Extensions = "xls"    'Only  xls
Case 2: Extensions = "xlsx"    'Only xlsx
Case 3: Extensions = "xlsm"    'Only xlsm
Case 4: Extensions = "xlsb"    'Only xlsb
Case 5: Extensions = "csv"    'Only csv
Case 6: Extensions = "txt"    'Only txt
Case 7: Extensions = ".*"    'All files with extension, use *.* for everything
Case 8: Extensions = "(xlsx|xlsm|xlsb)"  'xlsx, xlsm , xlsb
Case 9: Extensions = "(csv|txt)"   'csv and txt files
    'You can add more filter options if you want,
End Select

Select Case FileFilterOption
Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' "  'No Filter
Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' "    'Begins with
Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "\\." & Extensions & "$' "    ' Ends With
Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' "   'Contains
End Select

folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
                       Chr(34) & " to return quoted form of it's POSIX Path")
folderPath = Replace(folderPath, "'\''", "'\\''")

If Val(Application.Version) < 15 Then
    ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
                  folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                  Level & """)" & Chr(13)
    ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
    ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
    ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
    ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
    ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
    ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
    ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
    ScriptToRun = ScriptToRun & "foundPaths"
Else
    ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
                  folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                  Level & """ "
End If

On Error Resume Next
dirName = MacScript(ScriptToRun)
On Error GoTo 0
End Function

By the way, @urdearboy thanks for your suggestion, it really helped, although I had problems with the .PasteSpecial, I still found a workaround.

For anyone wondering, what the code does when you run it is it basically brings up a dialog box asking you to chose your desired folder, when you do, it finds files with the .xls extension (you can change that) and performs the change in all .xls files in that folder.

Thanks to everyone who commented on this post. ^_^

Upvotes: 2

urdearboy
urdearboy

Reputation: 14580

Note: this is not meant to be a solution and will be deleted. Just wanted to make a suggestion for OP

You should update your excel operations as follows.
This Link will show you alternatives to the .Select method.

With wks
    .Range("W4:X4") = "OFF -PEAK GEM(MW)"
    .Range("J33:M33") = "Hz"
    .Range("B33:I33") = "DETAILS"
    .Range("R34:X34").Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("R35:X35").Copy
    .Range("R35:x35").ClearContents
    .Range("R34").PasteSpecial
    .Range("K68:L123").Delete Shift:=xlToLeft
    .Range("K68:L68") = "UNITS ON BAR"
    .Range("V178") = "EXPECTED RESERVE"
End With

Upvotes: 1

Related Questions