Macros no longer work when workbook is shared

[cdchapman]

I have an interesting problem that I've not come across before when using Excel 2010.

I've created a spreadsheet at work that has two summary tabs which contain hyperlinks to around 30 separate sheet tabs.

On each sheet tab there is a list of unique values in column A (and other information relating to each value in columns B to D which are repeated for more than one unique value). In column E, users enter a test script name against each unique value they wish to 'reserve', and the macro picks out the unique test script names and via the COUNTIF formula counts the frequency of each test script name for each of the different values in column B.

My problem is that the macro seems to work fine if the workbook is not shared, but errors if the workbook is saved as shared. The error is 'Run time error 1004 - Unable to select the MergeCells property of the Range class'.

Here is the macro code:

Sub Get_Policies_Per_Script(updCol As Long, ShtName As String)
    Dim rowctr As Long
    Dim tgtrow As Long
    
    Const ppsformula As String = "=COUNTIFS($A$3:$A$65000,I$24,$E$3:$E$65000,$G"
    
    If updCol = 5 Then                   'test name column has been modified
        Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("G25:W65000").ClearContents
    
        Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("G25:W65000").Select
        With Selection
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Interior.Color = xlNone
            .MergeCells = False
        End With
        
        tgtrow = 25
        For rowctr = 3 To Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(Rows.Count, 1).End(xlUp).Row
            If Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(rowctr, 5).Value <> "" Then
                Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(tgtrow, 7).Value = Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(rowctr, 5).Value
                tgtrow = tgtrow + 1
            End If
        Next rowctr
        For rowctr = 25 To Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(Rows.Count, 7).End(xlUp).Row
            Range("G" & rowctr & ":H" & rowctr & "").Select
            Selection.MergeCells = True
            Selection.RowHeight = 11.25
        Next rowctr
        
        Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("$G$24:$H$" & Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(Rows.Count, 7).End(xlUp).Row & "").RemoveDuplicates Columns:=1, Header:=xlYes
                
        With Selection
            .WrapText = False
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Interior.Color = xlNone
        End With
        
        If Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("G25").Value <> "" Then
            Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("G25").Select
            Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("G25:W" & Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(Rows.Count, 7).End(xlUp).Row & "").Select
            With Selection
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Font.Name = "Arial"
                .Font.Size = 8
                .Interior.Color = RGB(255, 255, 204)
            End With
            Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("I25").Select
            For rowctr = 25 To Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Cells(Rows.Count, 7).End(xlUp).Row
                Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("I" & rowctr & "").Formula = ppsformula & rowctr & ")"
                Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("I" & rowctr & "").Select
                Selection.AutoFill Destination:=Range("I" & rowctr & ":W" & rowctr & ""), Type:=xlFillDefault
            Next rowctr
        End If
        Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets("" & ShtName & "").Range("A2").Select
    End If
End Sub

Any help would be appreciated...

Thanks
Chris

 

[Andrew Poulsom]

Some features aren't available in shared workbooks. They are best avoided because they are also prone to coruption.

Use a shared workbook to collaborate - Excel - Office.com

 

[cdchapman]

Thanks for replying, Andrew. The odd thing is though, if I comment out the two lines of code where 'MergeCells' appears, then I get another runtime error - Application defined or object defined error'.

Any ideas on why this new error is appearing?

 

[Andrew Poulsom]

Which line causes that error?

 

[cdchapman]

I don't know which line is causing the error as the macro is not viewable when the workbook is shared (the debug button is not available). Is there any other way I can find out which line it is whilst the workbook is shared?

 

[shg]

Unshare the workbook and try again. You can't edit macros in a shared workbook.

 

[cdchapman]

Shg - the macro works fine when the workbook is unshared - it only throws up these errors when the workbook is shared. For either error, I can't see the line that is in error as the macro becomes unviewable and the debug button is unavailable when the workbook is shared.

 

[shg]

You can't merge cells in a shared workbook -- I assume that limitation extends to VBA. From Help:

You do not expect to change the following features, which cannot be modified after a workbook is shared: merged cells, conditional formats, data validation, charts, pictures, objects (including drawing objects), hyperlinks, scenarios, outlines, subtotals, data tables, PivotTable reports, workbook and worksheet protection, and macros.

 

[cdchapman]

I've tried commenting out the two MergeCells lines in the code, which solves the first error (Unable to select the MergeCells...), but on sharing the workbook again, I then get the 'Application defined....' error, with no way of finding out which bit of code is causing this error. This is the problem I need help on.

 

[shg]

Try this. look in the status bar to see what the last message is before the code falls over. Then narrow it down.

Sub Get_Policies_Per_Script(updCol As Long, ShtName As String)</SPAN>
    Const sFrm      As String = "=COUNTIFS($A$3:$A$65000,I$24,$E$3:$E$65000,$G"</SPAN>
 
    Dim wks         As Worksheet</SPAN>
    Dim iRow        As Long     ' row index</SPAN>
    Dim lRow        As Long     ' last row in colG</SPAN>
 
    If updCol = 5 Then</SPAN>
        Set wks = Workbooks("Combined Policy Matrix v0.1.xlsm").Worksheets(ShtName)</SPAN>
 
        With wks</SPAN>
            .Range("G25:W65000").ClearContents</SPAN>
           
            Application.StatusBar = "Step 1"</SPAN>
            With .Range("G25:W65000")</SPAN>
                .Borders.LineStyle = xlNone</SPAN>
                .Interior.ColorIndex = xlColorIndexNone</SPAN>
                '.MergeCells = False</SPAN>
            End With</SPAN>
 
            Application.StatusBar = "Step 2"</SPAN>
            For iRow = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row</SPAN>
                If .Cells(iRow, "E").Value <> "" Then</SPAN>
                    .Cells(iRow + 22, "G").Value = .Cells(iRow, "E").Value</SPAN>
                End If</SPAN>
            Next iRow</SPAN>
 
            lRow = .Cells(.Rows.Count, "G").End(xlUp).Row</SPAN>
 
            Application.StatusBar = "Step 3"</SPAN>
            With .Range("G25", .Cells(lRow, "G"))</SPAN>
                .EntireRow.RowHeight = 11.25</SPAN>
                .RemoveDuplicates Columns:=1, Header:=xlYes</SPAN>
                .WrapText = False</SPAN>
                .Borders.LineStyle = xlNone</SPAN>
                .Interior.ColorIndex = xlColorIndexNone</SPAN>
            End With</SPAN>
 
            Application.StatusBar = "Step 4"</SPAN>
            If .Range("G25").Value <> "" Then</SPAN>
                With .Range("G25", .Cells(lRow, "W"))</SPAN>
                    .Borders.LineStyle = xlContinuous</SPAN>
                    .Font.Name = "Arial"</SPAN>
                    .Font.Size = 8</SPAN>
                    .Interior.Color = RGB(255, 255, 204)</SPAN>
                End With</SPAN>
 
                Application.StatusBar = "Step 5"</SPAN>
                .Range("I25", .Cells(lRow, "W")).Formula = sFrm & iRow & ")"</SPAN>
            End If</SPAN>
        End With</SPAN>
    End If</SPAN>
End Sub</SPAN>