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.

---

**Edit** to add: Your pasting decision could just be based on the value of `k` (which might better be called something like `outCol`) and the remaining table-making code simplified as follows:

            If k > 1 Then 'data was added
                ' Copy table
                ShWork.UsedRange.Copy ' all the data added to ShWork
                
                Set myShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse)
                'Set position:
                myShape.Left = -200
                myShape.Top = 150 + i
                i = i + 150
                
                ' Clear data from temporary sheet
                ShWork.UsedRange.Clear
            End If

    nextShpe: '...

You might still need to add your error checking back in; I can't tell what is causing that.