excelvbamodelingfinancial

Delete Sheets With No Color, Remove Comments from All Sheets, Break Links to All Sources


I am currently working on my first ever VBA macro to run the functions described in the title. I currently have the following code.

It appears to be working as intended, but I would love a second set of eyes to tell me if I have any unintended consequences or if there are more stable ways to write this. Thanks in advance, KP.

'
' deletecomments Macro
' delete comments, removetabs, break links for rolling models
'
' Keyboard Shortcut: Ctrl+alt+R
'
Public Sub RollModel()
Dim ws As Worksheet, cmt As Comment

For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
cmt.Delete
Next cmt
Next ws

   On Error Resume Next
   For Each it In ThisWorkbook.LinkSources
       For Each sh In Sheets
         sh.Cells.Replace it, ""
          For Each cl In sh.UsedRange.SpecialCells(-4174)
             If InStr(cl.Validation.Formula1, "#REF") Then cl.Validation.Delete
          Next
       Next
       ThisWorkbook.BreakLink it, 1
    Next

Application.DisplayAlerts = False
Dim Sht As Worksheet

For Each Sht In Worksheets
    If Sht.Tab.ColorIndex = xlColorIndexNone Then Sht.Delete
Next

Application.DisplayAlerts = True

End Sub

Solution

  • Am sure someone else can give you a better answer, but these are just some things I noticed.

    Also, sorry for bad formatting. Written on mobile. Untested.

    Option Explicit
    
    Public Sub RollModel()
    
    With thisworkbook
    
    Dim ws As Worksheet
    
    For Each ws In .Worksheets
    Ws.cells.clearcomments
    Next ws
    
    ' I assume your on error resume next was because when there are no LinkSources, vbempty is returned instead of an array -- which you can't iterate over '
    
    ' Also, this method can also return a 2 dimensional array according to https://learn.microsoft.com/en-us/office/vba/api/excel.workbook.linksources -- which would cause an error as array indexes below are one-dimensional '
    
    Dim linkArray as variant
    Linkarray = .linksources
    
    Dim linkIndex as long
    Dim cell as range
    
    If not isempty(linkarray) then
    
    For linkIndex = Lbound(linkarray) to ubound(linkarray)
    
    For Each ws In .Worksheets
    
    Ws.cells.replace linkarray(linkIndex), ""
    
    For Each cell In ws.cells.SpecialCells(xlCellTypeAllValidation)
    If InStr(cell.Validation.Formula1, "#REF") Then
    cl.Validation.Delete ' Not sure if this is the best way/approach, so have not really changed it.'
    End if
    Next cell
    
    Next ws
    
    .BreakLink linkarray(linkIndex), xlLinkTypeExcelLinks
    
    Next linkIndex
    
    End if
    
    For Each ws In .Worksheets
    
    If ws.Tab.ColorIndex = xlColorIndexNone Then
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
    
    Next ws
    
    End With
    
    End Sub