Public Sub averageScoreRelay()
    ' 1. Run from PPT and open an Excel file
    ' 2. Start at slide 1 and find a box that contains the words "iq_", if it has those words then it will have numbers after it like so "iq_43" or "iq_43, iq_56,iq_72".
    ' 3. find those words and numbers in the opened Excel file after splitting and re-formating string.
    ' 3. Copy column into a new sheets and repeat for all "iq_'s" until sheets 2 has a table.
    ' 4. Copy table from xl Paste Table into ppt
    ' 5. Do this for every slide



'Timer start
    Dim StartTime As Double
    Dim SecondsElapsed As Double
        StartTime = Timer


'Create variables
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim ShRef As Excel.Worksheet
    Dim ShWork As Excel.Worksheet
    Dim pptPres As Object
    Dim colNumb As Long

    ' Create new excel instance and open relevant workbook
    Set xlApp = New Excel.Application
    'xlApp.Visible = True 'Make Excel visible
    Set xlWB = xlApp.Workbooks.Open("C:\Users\Andre Kunz\Desktop\Gate\Macros\averageScores\pptxlpratice\dummy2.xlsx", True, False, , , , True, Notify:=False) 'Open relevant workbook
    If xlWB Is Nothing Then ' may not need this if statement. check later.
        MsgBox ("Error retrieving Average Score Report, Check file path")
        Exit Sub
    End If
    xlApp.DisplayAlerts = False

    'Find # of iq's in workbook
    Set ShRef = xlWB.Worksheets("Sheet1")
        colNumb = ShRef.Cells(1, ShRef.Columns.Count).End(xlToLeft).Column

    Dim IQRef() As String
    Dim iCol As Long

    ReDim IQRef(colNumb)
    ' capture IQ refs locally
        For iCol = 2 To colNumb
            IQRef(iCol) = ShRef.Cells(1, iCol).Value
        Next iCol

    'Create a new blank Sheet in excel, should be "Sheet2"
    xlWB.Worksheets.Add After:=xlWB.ActiveSheet
    Set ShWork = xlWB.Worksheets("Sheet2")

    'Make pptPres the ppt active
    Set pptPres = PowerPoint.ActivePresentation

    'Create variables for the slide loop
    Dim pptSlide As Slide
    Dim Shpe As Shape
    Dim pptText As String
    Dim iq_Array As Variant
    Dim arrayLoop As Long
    Dim myShape As Object
    Dim k As Long
    Dim i As Long
    Dim lRows As Long
    Dim lCols As Long

    'Loop through each pptSlide and check for IQ text box, grab avgScore values and create pptTable
    For Each pptSlide In pptPres.Slides

        i = 0
        pptSlide.Select

        'searches through shapes in the slide
        For Each Shpe In pptSlide.Shapes

            If Not Shpe.HasTextFrame Then GoTo nextShpe 'boom, one less nested If statement
            If Not Shpe.TextFrame.HasText Then GoTo nextShpe ' boom, another nested If statement bites the dust

            k = 1

                    'Set pptText as the Text in the box, then make it lowercase and trim Spaces and Enters
                    pptText = Shpe.TextFrame.TextRange
                    pptText = LCase(Replace(pptText, " ", vbNullString))
                    pptText = Replace(Replace(Replace(pptText, vbCrLf, vbNullString), vbCr, vbNullString), vbLf, vbNullString)


                    'Identify if within text there is "iq_"
                    If InStr(1, pptText, "iq_") <= 0 Then GoTo nextShpe

                    'set iq_Array as an array of the split iq's
                    iq_Array = Split(pptText, ",")

                    Dim hasIQs As Boolean
                    Dim checkStr As String
                    Dim pCol As Long

                    hasIQs = iq_Array(0) Like "iq_#" Or iq_Array(0) Like "iq_##" Or iq_Array(0) Like "iq_###"

                    If hasIQs Then
                        ' paste inital column into temporary worksheet
                        ShRef.Columns(1).Copy Destination:=ShWork.Columns(1)
                    End If

                    ' loop for each iq_ in the array
                    For arrayLoop = LBound(iq_Array) To UBound(iq_Array)
                        ' Take copy of potential ref and adjust to standard if required
                        checkStr = iq_Array(arrayLoop)
                        If hasIQs And Left(checkStr, 3) <> "iq_" Then checkStr = "iq_" & checkStr

                        ' Look for existence of corresponding column in local copy array
                        pCol = 0
                        For iCol = 2 To colNumb
                            If checkStr = IQRef(iCol) Then
                                pCol = iCol
                                Exit For
                            End If
                        Next iCol

                        If pCol > 0 Then
                            ' Paste the corresponding column into the forming table
                            k = k + 1
                            ShRef.Columns(pCol).Copy Destination:=ShWork.Columns(k)
                        End If

                    Next arrayLoop

    'calculate last row and last column on sheet2. aka. find Table size
    With ShWork
        lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCols = .Cells(1, .Columns.Count).End(xlToLeft).Column

        'If only one column then go to next slide
        If lRows = .Cells(1, 1).End(xlUp).Row And lCols = .Cells(1, 1).End(xlToLeft).Column Then
            GoTo nextSlide
        End If

            'Copy table
            .Range(.Cells(1, 1), .Cells(lRows, lCols)).Copy
    End With

tryAgain:

            ActiveWindow.ViewType = ppViewNormal
            ActiveWindow.Panes(2).Activate
            'Paste Table into ppt
            pptSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse

            On Error GoTo tryAgain
            On Error GoTo clrSht

            'Recently pasted shape is the last shape on slide, so it will be the same as count of shapes on slide
            Set myShape = pptSlide.Shapes(pptSlide.Shapes.Count)

            'Set position:
            myShape.Left = -200
            myShape.Top = 150 + i

            i = i + 150

clrSht:

            'Clear Sheet2 for next slide
            ShWork.Range("A1:P10").Clear

nextShpe:

        Next Shpe

nextSlide:

    Next pptSlide

    ShWork.Delete
    xlWB.Close
    xlApp.Quit

    xlApp.DisplayAlerts = True

    'End Timer
    SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub