I recommend setting up objects for the Excel worksheets:

Dim ShRef As Excel.Worksheet
Dim ShWork As Excel.Worksheet

Set ShRef = xlWB.Worksheets("Sheet1")
'Create a new temporary worksheet in excel
Set ShWork = xlWB.Worksheets.Add(After:=xlWB.ActiveSheet)
    

A lot of your time is probably spent look at Excel and doing copy/paste stuff.

The referencing can certainly be quicker; you just need to collect the iq_999 numbers and corresponding columns into a local reference. This can be as simple as an array that you review each time, which is still far quicker than checking across into an Excel cell.

Dim IQRef() As String
Dim iCol As Long
' get number of IQ references
colNumb = ShRef.Cells(1, ShRef.Columns.Count).End(xlToLeft).Column
ReDim IQRef(colNumb)
' capture IQ refs locally
For iCol = 2 To colNumb
    IQRef(iCol) = ShRef.Cells(1, iCol).Value
Next iCol

and then for your main table-building, you only need to check the first element once to decide if subsequent numbers :

                    '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
                

One possible bug is that you reset k your output column to 1 with each Shape but you only output for each Slide. If there is more than one Shape with relevant information you will lose some or all of the first Shape's input in your table.