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\pinlop\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 sld As Slide
    Dim shpe As Shape
    Dim cTitle As String
    Dim iq_Array As Variant
    Dim arrayLoop As Long
    Dim myShape As Object
    Dim outCol As Long
    Dim iOffset As Long
    Dim lRows As Long
    Dim lCols As Long

    'Loop through each sld and check for chart title, grab avgScore values and create pptTable to paste into ppt chart
    For Each sld In pptPres.Slides

        iOffset = 0
        sld.Select

        'searches through shapes in the slide
        For Each shpe In sld.Shapes

            If Not shpe.HasChart Then GoTo nxtShpe
            If Not shpe.Chart.HasTitle Then GoTo nxtShpe

            Set c = shpe.Chart

            If c.ChartType = xlPie Then GoTo nxtShpe

            outCol = 1

                    'Set cTitle as the Text in the title, then make it lowercase and trim Spaces and Enters
                    cTitle = c.ChartTitle.Text
                    cTitle = LCase(Replace(cTitle, " ", vbNullString))
                    cTitle = Replace(Replace(Replace(cTitle, vbCrLf, vbNullString), vbCr, vbNullString), vbLf, vbNullString)


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

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

                    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

    With c.ChartData
        .Activate
        .Workbooks.Sheets(1).UsedRange.Clear
        .Workbooks.Sheets(1).Range(A2).Paste
        .Workbooks.Close
    End With

                    ' 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 sld

    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