Code work in 365 but not working in version 2013

[ceecee88]

Hi, I asked the question before and already have the code working for selected all shapes from specific row downward, but the issue now is that it won't work in version 2013. It is show error message, not sure what the issue is. Please see the existing code below. Your suggestion will be much appreciated.

Thank you

Private Sub SelectShapes()
Dim shp As Shape, Lft As Integer, Rht As Integer, Bot As Integer
Lft = 999: Rht = 1: Top = 999

Application.ScreenUpdating = False
Worksheets("Sheet1").Select
For Each shp In ActiveSheet.Shapes
    If shp.TopLeftCell.Row > 6 Then
        Lft = Application.WorksheetFunction.Min(Lft, shp.TopLeftCell.Column)
        Top = Application.WorksheetFunction.Min(Top, shp.TopLeftCell.Row)
        Rht = Application.WorksheetFunction.Max(Rht, shp.BottomRightCell.Column)
        Bot = Application.WorksheetFunction.Max(Bot, shp.BottomRightCell.Row)
   
    End If
 
Next shp
 If Not (Lft = 999 And Top = 999) Then Range(Cells(Top - 2, Lft - 1), Cells(Bot + 2, Rht)).Select
 Application.ScreenUpdating = True
 
End Sub

 

[DanteAmor]

Resolving this thread I realized that if the shape is hidden you can't use it.
So first you have to make them visible.

Application Or Object Defined Error Deleting Worksheet Shapes

Then try the following code:

Private Sub SelectShapes()
  Dim shp As Shape, Lft As Long, Rht As Long, Bot As Long, top As Long, k As Long
  Lft = 999
  Rht = 1
  top = 999
 
  Worksheets("Sheet1").Select

  For k = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(k).Visible = msoTrue
  Next k
  
  For Each shp In ActiveSheet.Shapes
    If shp.TopLeftCell.Row > 6 Then
      Lft = Application.WorksheetFunction.Min(Lft, shp.TopLeftCell.Column)
      top = Application.WorksheetFunction.Min(top, shp.TopLeftCell.Row)
      Rht = Application.WorksheetFunction.Max(Rht, shp.BottomRightCell.Column)
      Bot = Application.WorksheetFunction.Max(Bot, shp.BottomRightCell.Row)
    End If
  Next shp
  
  If Not (Lft = 999 And top = 999) Then
    If Lft > 1 Then Lft = Lft - 1
    Range(Cells(top - 2, Lft), Cells(Bot + 2, Rht)).Select
  End If
End Sub

If it doesn't work, then use the code from post #10

 

[ceecee88]

Resolving this thread I realized that if the shape is hidden you can't use it.
So first you have to make them visible.

Application Or Object Defined Error Deleting Worksheet Shapes

Then try the following code:

Private Sub SelectShapes()
  Dim shp As Shape, Lft As Long, Rht As Long, Bot As Long, top As Long, k As Long
  Lft = 999
  Rht = 1
  top = 999
 
  Worksheets("Sheet1").Select

  For k = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(k).Visible = msoTrue
  Next k
 
  For Each shp In ActiveSheet.Shapes
    If shp.TopLeftCell.Row > 6 Then
      Lft = Application.WorksheetFunction.Min(Lft, shp.TopLeftCell.Column)
      top = Application.WorksheetFunction.Min(top, shp.TopLeftCell.Row)
      Rht = Application.WorksheetFunction.Max(Rht, shp.BottomRightCell.Column)
      Bot = Application.WorksheetFunction.Max(Bot, shp.BottomRightCell.Row)
    End If
  Next shp
 
  If Not (Lft = 999 And top = 999) Then
    If Lft > 1 Then Lft = Lft - 1
    Range(Cells(top - 2, Lft), Cells(Bot + 2, Rht)).Select
  End If
End Sub

If it doesn't work, then use the code from post #10

Sorry, I didn't see your reply. I just went with On Error Resume Next ^^" Since I have no idea what is going on and there were no hidden shapes but thank you so much for your help.