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 outCol 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

            outCol = 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
                    Dim checkOne

                    checkOne = iq_Array(0)

                    hasIQs = Left(checkOne,3) = "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
                            outCol = outCol + 1
                            ShRef.Columns(pCol).Copy Destination:=ShWork.Columns(outCol)
                        End If

                    Next arrayLoop

                If outCol > 1 Then 'data was added
                    ' Copy table
                    ShWork.UsedRange.Copy ' all the data added to ShWork

tryAgain:

                    ActiveWindow.ViewType = ppViewNormal
                    ActiveWindow.Panes(2).Activate

                    Set myShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse)

                    On Error GoTo tryAgain
                    On Error GoTo clrSht

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

                    ' Clear data from temporary sheet
                    ShWork.UsedRange.Clear
                End If

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