Find shape in PPT and retreive text then search for that text in Excel, copy column then paste it back into PPT as a table

Question

This is my first real attempt to create something in VBA, so be gentle please. This is what I need my program to do:

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. Needs to recognize that ", " means there is another entry.
4. Copy column containing words from ppt ie. "iq_43"
5. Paste a Table into ppt with those values
6. Do this for every slide

I'm having issues with my function at the bottom. This is where the program should be shifting to work in the opened excel file. The idea there is to go through the headers of each column and search for values that I have stored in "iq_Array". Once values are found, then copy rows below it into another array called "tble" (which will eventually be pasted onto the powerpoint slide as a table).

The code currently stops at

rng = Worksheets("Sheet1").Cells(1, i).Value

I'm not sure what I'm doing wrong here. Once fixed, will this is be able to be copied into an array?

Another part I believe I'm having trouble with is how to return the function values. I currently have

xlFindText(iq_Array, xlWB) = tble()

At the bottom of my function in order to call it as such in my main code. Is this the proper way to do it?

Public Sub averageScoreRelay()



'Create variables
        Dim xlApp As Excel.Application
        Dim xlWB As Excel.Workbook
        Dim pptSlide As Slide
        Dim fileName As String
        Dim Shpe As Shape
        Dim pptText As String
        Dim strArray As String
        Dim pptPres As Object
        Dim PowerPointApp As Object
        Dim iq_Array

' 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\Macro\averageScores\pptxlpratice\dummyavgscore.xlsx", True, 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

'Is PowerPoint already opened?
'Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Make PPT visible
Set pptPres = PowerPoint.ActivePresentation

Set pptSlide = Application.ActiveWindow.View.Slide      'Set pptSlide = pptPres.Slides _
                                                            (PowerPointApp.ActiveWindow.Selection.SlideRange.SlideIndex)  (different way of saying the same thing?)

'Loop through each pptSlide and check for IQ text box, grab avgScore values and create pptTable
        For Each pptSlide In pptPres.Slides
                'searches through shapes in the slide
                For Each Shpe In pptSlide.Shapes
                                'Identify if there is text frame
                                If Shpe.HasTextFrame Then
                                        'Identify if there's text in text frame
                                        If Shpe.TextFrame.HasText Then
                                            pptText = Shpe.TextFrame.TextRange
                                                If InStr(1, pptText, "iq_") > 0 Then 'Identify if within text there is "iq_" All IQ's have to be formatted like this "iq_42, iq_43" for now
                                                        iq_Array = Split(pptText, ", ")               'Use function below to Set iq_Array to an array of all iq_'s in the text box
                                                        xlFindText(iq_Array, xlWB).Copy
                                                        pptSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse                      ' Paste the Array
                                                End If
                                        End If
                                End If
                Next Shpe
        Next pptSlide

End Sub


Function xlFindText(iq_Array, xlWB) 'This function works in excel and saves the column values into xlFindText(iq_Array, xlWB) to be pasted as a table into ppt
        'SetsxlTextID = to the array of iq_'s
        Dim i As Integer
        Dim k As Integer
        Dim activeWB As Excel.Workbook
        Dim size As String
        Dim rng As Range
        Dim tble As Range

        'for loop to go through values stored in array

        size = UBound(iq_Array) - LBound(iq_Array)

        For i = 0 To size                                               'loops through array values
                For k = 1 To 200                                        'loops through cloumns
                        rng = Worksheets("Sheet1").Cells(1, i).Value
                        If rng = iq_Array(i) Then         'matches column value to iq_Array
                                Columns(k).Select
                                tble(i) = Selection.Copy                'saves a copy of the range into tble() array
                        End If
                Next k
        Next i

        xlFindText(iq_Array, xlWB) = tble()

End Function

Answer 1

There are several problems with your code, I'll go from start to end, but it may well be I'm missing some.

(1)

Set pptSlide = Application.ActiveWindow.View.Slide

is pointless because directly afterwards you overwrite pptSlide with:

    For Each pptSlide In pptPres.Slides

xlFindText

(2)

rng = Worksheets("Sheet1").Cells(1, i).Value

If you work with a different Office program than the one where the code runs in (here Excel from PPT), you always must fully qualify your objects. Don't use shortcuts like ActiveSheet without specifying the parent object (Excel application).

So this should be:

xlWB.Worksheets("Sheet1").Cells(1, i).Value

The same applies to Columns(k).

(3)

rng is a Range object. This doesn't go together with a cell value.

Either

Set rng = xlWB.Worksheets("Sheet1").Cells(1, i)

or

Dim varValue As Variant
varValue = xlWB.Worksheets("Sheet1").Cells(1, i).Value

(4)

tble(i) = Selection.Copy

This is not how Range.Copy works, please check the Excel Online Help.

You will have to change the logic of xlFindText - either return a column number from this function and do the Copy + Paste in the main function, or do both in xlFindText (then pass pptSlide as parameter).