Consulting

Results 1 to 16 of 16

Thread: 'subscript is out of range'

  1. #1

    'subscript is out of range'

    I currently have a Macro running for the attached file that sorts the shapes based on the date in the shape (latest date to older). The macro runs fine on the first page, but on the second page I keep getting an error message saying the 'Subscript is out of range'.

    Also, although the macro works on the first page, the boxes jump to a different position on the page, is there anyway to fix this?

    Can someone help me to figure out what is wrong with this file? Thanks!

    PPT Trial_Sorter.pptm

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    "Subscript Out of Range" means the identifier in the parenthesis does not exist.

    Example slides(21) when there are only 20 slides. (Or 21 if PP counts from zero)
    If counting from zero, the last allowed subscript would be .Count - 1

    If you use names, check for correct speiling
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Thanks Sam! So how would I fix this in relation to slide 2 of this file? The number in the parenthesis says 28, and there are exactly 28 objects on the page. Still gives me the "Subscript out of range" error.

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Does PP count slides from zero?

    Simple test code
    Sub T()
    Dim X
    X = slides(0) 'also try Shapes(0) I don't know PP rules
    Set x = slides(0)
    End sub
    Where was the error, if any

    I know VBA in general and VBA for Excel in particular, but all MS programs differ slightly in implementing VBA.

    Show us your VBA code, I don't have PP on my computer, But I should understand the code.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  5. #5
    Here is the code:

    Option Explicit
    
    Sub sortDates()
    Dim rayshapes() As Shape
    Dim x As Integer
    Dim y As Integer
    Dim t As Integer
    Const initL As Single = 56.29528
    Const initT As Single = 125.3445
    Const incL As Single = 122.5583
    Const incT As Single = 131.2299
    
    Dim oshp As Shape
    Dim osld As Slide
    Set osld = ActiveWindow.Selection.SlideRange(1)
    ReDim rayshapes(1 To osld.Shapes.Count - 1)
    
    For Each oshp In osld.Shapes
    If oshp.Type = msoGroup Then
    x = x + 1
    Set rayshapes(x) = oshp '<-- This is where I am getting the error for "subscript out of range"
    End If 'only groups
    Next oshp
    
    Call SortByDate(rayshapes)
    t = 0
    x = 0
    
    For y = 1 To UBound(rayshapes)
    x = x + 1
    If x = 8 Then
    x = 1
    t = t + 1
    End If
    
    rayshapes(y).Left = initL + (x - 1) * incL
    rayshapes(y).Top = initT + (t * incT)
    Next y
    End Sub

    Sub SortByDate(Arrayin As Variant)
       Dim b_Cont As Boolean
       Dim rayShape As Shape
       Dim lngCount As Long
       Dim vSwap As Shape
       Dim dateShape As Shape
       Dim shp1 As Shape
       Dim otr As TextRange
       Dim GI As Shape
       
       Dim otr2 As TextRange
       Dim thisDate As Date
       Dim thisDate2 As Date
       Dim ipos As Integer
    
       Do
          b_Cont = False
          
          For lngCount = LBound(Arrayin) To UBound(Arrayin) - 1
         Set rayShape = Arrayin(lngCount)
             Set dateShape = rayShape.GroupItems(rayShape.GroupItems.Count)
             Set otr = dateShape.TextFrame.TextRange
             Debug.Print otr.Text
             ipos = InStr(otr.Paragraphs(2).Text, "–")
    
             If ipos > 0 Then
             thisDate = CDate(Left(otr.Paragraphs(2).Text, ipos - 2))
             Else
             thisDate = CDate(otr.Paragraphs(2).Text)
             End If
    
             Set rayShape = Arrayin(lngCount + 1)
             Set dateShape = rayShape.GroupItems(rayShape.GroupItems.Count)
             Set otr2 = dateShape.TextFrame.TextRange
             ipos = InStr(otr2.Paragraphs(2).Text, "–")
    
             If ipos > 0 Then
             thisDate2 = CDate(Left(otr2.Paragraphs(2).Text, ipos - 2))
             Else
             thisDate2 = CDate(otr2.Paragraphs(2).Text)
             End If
    
             If thisDate < thisDate2 Then
                Set vSwap = Arrayin(lngCount)
                Set Arrayin(lngCount) = Arrayin(lngCount + 1)
                Set Arrayin(lngCount + 1) = vSwap
                b_Cont = True
             End If
          Next lngCount
       Loop Until Not b_Cont
       'release objects
       Set vSwap = Nothing
       Exit Sub
    End Sub

    'Function getDateHolder(oshp As Shape) As Shape
    'Dim G As Long
    
    'If oshp.Type = msoGroup Then
    'For G = 1 To oshp.GroupItems.Count
    'If oshp.GroupItems(G).HasTextFrame Then
    'If oshp.GroupItems(G).TextFrame.TextRange.Paragraphs.Count = 2 Then
    'Set getDateHolder = oshp.GroupItems(G)
    'Exit Function
    'End If
    'End If
    'Next
    'End If
    'End Function
    Sub sortNames()
    Dim rayshapes() As Shape
    Dim x As Integer
    Dim y As Integer
    Dim t As Integer
    Const initL As Single = 233.7844
    Const initT As Single = 153.2876
    Const incL As Single = 84.08623
    Const incT As Single = 137.6572
    
    Dim oshp As Shape
    Dim osld As Slide
    
    Set osld = ActiveWindow.Selection.SlideRange(1)
    ReDim rayshapes(1 To osld.Shapes.Count - 1)
    
    For Each oshp In osld.Shapes
    If oshp.Type = msoGroup Then
    x = x + 1
    Set rayshapes(x) = oshp
    End If 'only groups
    Next oshp
    
    Call SortByName(rayshapes)
    t = 0
    x = 0
    
    For y = 1 To UBound(rayshapes)
    x = x + 1
    
    If x = 7 Then
    x = 1
    t = t + 1
    End If
    
    rayshapes(y).Left = initL + (x - 1) * incL
    rayshapes(y).Top = initT + (t * incT)
    Next y
    End Sub
    Sub SortByName(Arrayin As Variant)
       Dim b_Cont As Boolean
       Dim rayShape As Shape
       Dim rayShape2 As Shape
       Dim lngCount As Long
       Dim vSwap As Shape
       Dim otr As TextRange
       Dim otr2 As TextRange
       Dim ipos As Integer
    
       Do
          b_Cont = False
          For lngCount = LBound(Arrayin) To UBound(Arrayin) - 1
          Set rayShape = Arrayin(lngCount)
          Set rayShape2 = Arrayin(lngCount + 1)
    
    If UCase(rayShape.GroupItems(rayShape.GroupItems.Count).TextFrame.TextRange.Words(2).Text) > UCase(rayShape2.GroupItems(rayShape.GroupItems.Count).TextFrame.TextRange.Words(2).Text) Then
            Set vSwap = Arrayin(lngCount)
                Set Arrayin(lngCount) = Arrayin(lngCount + 1)
                Set Arrayin(lngCount + 1) = vSwap
                b_Cont = True
             End If
          Next lngCount
    
       Loop Until Not b_Cont
       'release objects
       Set vSwap = Nothing
       Exit Sub
    End Sub
    Last edited by SamT; 06-15-2017 at 07:37 AM. Reason: Added Code formatting tags and whitespace

  6. #6
    2017-06-15_9-15-55.jpg

    Here is a screenshot of the page. The code sorts the shapes based on the date in the shape (from most recent to earliest). It works on another page for a set of test shapes, but not on these.

  7. #7
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    First, I would make two changes and test them
    Dim rayshapes As Variant 'A Variant can hold any Type and works very slightly different than an Array.
    ReDim rayshapes(1 To osld.Shapes.Count) 'The full Count
    Explanation:
    ReDim rayshapes(1 To osld.Shapes.Count - 1) ---The Upper Bound of the array is one less than the Collection Count
    For Each oshp In osld.Shapes
    ...
    x = x + 1 --- Eventually x will equal the collection count, or, 1 more than rayshapes' UBound



    BTW, it looks like you have a good grasp of PP.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  8. #8
    I made the changes you suggested but now I'm getting this "type mismatch" error

    2017-06-15_11-17-58.jpg

  9. #9
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Good. That means you fixed the first issue. :

              Debug.Print otr.Text 
                ipos = InStr(otr.Paragraphs(2).Text, "–") 
                 
                If ipos > 0 Then 
                    thisDate = CDate(Left(otr.Paragraphs(2).Text, ipos - 2)) 
                Else 
                    thisDate = CDate(otr.Paragraphs(2).Text) 
                End If

    From the code above, I assume that the second Para in otr.txt is in the form of either
    "DateString - More text"
    Or just
    "DateString"

    Take a look at otr.Paragraphs(2).Text when you get the error
    If ipos > 0 Then 
                    thisDate = CDate(Left(otr.Paragraphs(2).Text, ipos - 2)) 
                Else 
    msgbox otr.Paragraphs(2).Text '<-- add line
                    thisDate = CDate(otr.Paragraphs(2).Text) 
                End If
    What is the Format of the Date String?

    BTW, if you indent and space your code like in all the "Code Blocks" above, your code will be much easier to read.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  10. #10
    This is what it's showing me.
    2017-06-15_15-05-52.jpg
    Attached Images Attached Images

  11. #11
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    CDate(0) = 12:00:00AM

    Take a look at otr.Paragraphs(2).Text when you get the error
    If ipos > 0 Then 
        thisDate = CDate(Left(otr.Paragraphs(2).Text, ipos - 2)) 
    Else 
        msgbox otr.Paragraphs(2).Text '<-- add line
        thisDate = CDate(otr.Paragraphs(2).Text) 
    End If
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  12. #12
    Where exactly should I be adding the "CDate(0) = 12:00:00AM"?

    Sorry for all the questions. I just want to get this right!

  13. #13
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Where exactly should I be adding the "CDate(0) = 12:00:00AM"?
    Nowhere.That was a statement of fact. If you convert zero to a date, you get 12:00:00AM as the result

    Example code
    Sub TestDateZero()
    MsgBox CDate(0)
    End Sub
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  14. #14
    I added the line you said to add, but it is still coming up as a "type mismatch" for the line below it.

    2017-06-15_16-50-49.jpg

  15. #15
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    And... What did the MsgBox say?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  16. #16
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Here is how to redim arrays based on type

    Sub sortDates()Dim rayshapes() As Shape
    Dim x As Integer
    Dim y As Integer
    Dim t As Integer
    Const initL As Single = 56.29528
    Const initT As Single = 125.3445
    Const incL As Single = 122.5583
    Const incT As Single = 131.2299
    
    
    Dim oshp As Shape
    Dim osld As Slide
    Set osld = ActivePresentation.Slides(2)
    ReDim rayshapes(1 To 1)
    For Each oshp In osld.Shapes
    If oshp.Type = msoGroup Then
    x = x + 1
    Set rayshapes(x) = oshp
    ReDim Preserve rayshapes(1 To UBound(rayshapes) + 1)
    End If 'only groups
    Next oshp
    If UBound(rayshapes) > 1 Then
    'strip extra value
    ReDim Preserve rayshapes(1 To UBound(rayshapes) - 1)
    End If
    Call SortByDate(rayshapes)
    t = 0
    x = 0
    For y = 1 To UBound(rayshapes)
    x = x + 1
    If x = 8 Then
    x = 1
    t = t + 1
    End If
    rayshapes(y).Left = initL + (x - 1) * incL
    rayshapes(y).Top = initT + (t * incT)
    Next y
    End Sub
    The error in the second sub is because there are two type of dashes in the dates and your code ignopres one of them so the result is nor a date.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •