Using Cells inside of Range isn't working?

Question

For some reason this isn't working:

.Range(Cells(1, 1), Cells(lRows, lCols)).Copy

Any ideas? It's on line 78

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

    'Create variables
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim pptSlide As Slide
    Dim Shpe As Shape
    Dim pptText As String
    Dim pptPres As Object
    Dim iq_Array As Variant
    Dim arrayLoop As Integer
    Dim i As Integer
    Dim myShape As Object
    Dim colNumb As Integer
    Dim size As Integer
    Dim k As Integer
    Dim vsblSld As Object
    Dim lRows As Long
    Dim lCols As Long

    colNumb = 5 'Set #of columns in the workbook

    ' 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

    xlWB.Worksheets.Add After:=xlWB.ActiveSheet

    'Make pptPres the ppt active
    Set pptPres = PowerPoint.ActivePresentation

    '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
            k = 1
            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, ", ")               'set iq_Array as an array of the split iq's
                        size = UBound(iq_Array) - LBound(iq_Array)
                        For arrayLoop = 0 To size   'loop for each iq_array
                            For i = 1 To colNumb    'loops for checking each column
                                If i = 1 And arrayLoop = 0 Then  'Copies the first column for every slide
                                    xlWB.Worksheets("Sheet1").Columns(1).Copy   'copy column
                                    xlWB.Worksheets("Sheet2").Paste Destination:=xlWB.Worksheets("Sheet2").Columns(1)
                                ElseIf xlWB.Worksheets("Sheet1").Cells(1, i) = iq_Array(arrayLoop) And i <> 1 Then 'if iq in ppt = iq in xl and if not the first cell then execute
                                    k = k + 1
                                    xlWB.Worksheets("Sheet1").Columns(i).Copy
                                    xlWB.Worksheets("Sheet2").Paste Destination:=xlWB.Worksheets("Sheet2").Columns(k)
                                End If
                            Next i
                        Next arrayLoop
                    End If
                End If
            End If
        Next Shpe

    'calculate last row and last column
    With xlWB.Worksheets("Sheet2")
        lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(Cells(1, 1), Cells(lRows, lCols)).Copy
    End With
            pptSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse
            Set myShape = pptSlide.Shapes(pptSlide.Shapes.Count)
            'Set position:
            myShape.Left = 66
            myShape.Top = 152
            xlWB.Worksheets("Sheet2").Range("A1:P10").Clear
    Next pptSlide

    xlWB.Worksheets("Sheet2").Delete

End Sub

score 2 · Accepted Answer · answered Sep 13 '17 at 18:00

2

It should be like this:

.Range(.Cells(1, 1), .Cells(lRows, lCols)).Copy

That's one of the errors everyone experiences with VBA, if he goes a bit deeper. The reason is that Cells and Range should both be referred to the worksheet, otherwise they would refer the ActiveSheet.

And in general, consider using Long instead of Integer in your code.

answered Sep 13 '17 at 18:00

Vityata

42,633
8
55
100

Oh wow... I thought I tried that haha. So simple! Thank you very much! – Pinlop Sep 13 '17 at 18:06
@Pinlop :) Welcome – Vityata Sep 13 '17 at 18:07
1

@Pinlop You can [accept the answer](https://meta.stackexchange.com/questions/5234/how-does-accepting-an-answer-work) if your question is correctly answered. – danieltakeshi Sep 13 '17 at 18:18
@Vityata Would you happen to know why whenever the tables are pasted onto the slides, only the slide I currently have selected will paste the table at the right coordinates. All others will only show as pasted in the right coordinates in the thumbnail but they are in-fact pasted in the middle of the slide like so: https://imgur.com/a/zVUc4 – Pinlop Sep 13 '17 at 18:25
@Pinlop - nope. But try selecting all slides and paste it, it may work. – Vityata Sep 13 '17 at 18:29
@Vityata That's it! thank you :) – Pinlop Sep 13 '17 at 19:33

Using Cells inside of Range isn't working?

1 Answers1