Variable Array based on cell value

[eduardodanon]

Hello, everybody.
The following code shows an array with fixed size, with 6 values. What should i do to make its size depends on a cell value? For example, if the user writes 10 lines of values (meaning 10 ranges of 10 sheets) the array gets all the values. And also, if the user writes only 2, the array gets only 2.

Dim MySlideArray As Variant
Dim MyRangeArray As Variant
'List of PPT Slides to Paste to
MySlideArray = Array(2, 3, 4, 5, 6, 7)
'List of Excel Ranges to Copy from. For now, assume that it's always 5 ranges
With tb.DataBodyRange
MyRangeArray = Array(Worksheets(.Cells(1, 1).Value).Range(.Cells(1, 2).Value), _
Worksheets(.Cells(2, 1).Value).Range(.Cells(2, 2).Value), _
Worksheets(.Cells(3, 1).Value).Range(.Cells(3, 2).Value), _
Worksheets(.Cells(4, 1).Value).Range(.Cells(4, 2).Value), _
Worksheets(.Cells(5, 1).Value).Range(.Cells(5, 2).Value), _
Worksheets(.Cells(6, 1).Value).Range(.Cells(6, 2).Value))


'Loop through Array data
For x = LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel Range
MyRangeArray(x).Copy

'Paste to PowerPoint and position
On Error Resume Next
Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
On Error GoTo 0

[Aflatoon]

If the table only contains populated cells in that column:

MyRangeArray = application.transpose(.columns(2).Value)

[eduardodanon]

Hello, thanks for your answer!
MySlideArray would be the number of populated cells,
MyRangeArray would be the joining of column 1 with column 2 ( column 1 contains the sheet name and column 2 the range of the sheet)

Could you make the adaptation to your code? Im having trouble in doing so

If the table only contains populated cells in that column:

MyRangeArray = application.transpose(.columns(2).Value)

[Aflatoon]

Ah, OK I misread the code.
Does your table have values in every row for the sheet names, or could it contain blank rows?

[eduardodanon]

yes, it does have values in every row for the sheet name and It will not have blank rows!
Example:

Worksheet Name	Range
Sheet1	B3:K18
Sheet4	C9:K35
Sheet2	B1:K19
Sheet5	A3:K18
Sheet3	B3:K18

Ah, OK I misread the code.
Does your table have values in every row for the sheet names, or could it contain blank rows?

[Aflatoon]

Something like:

Dim n As Long

With tb.DataBodyRange
    ReDim myrangearray(.Rows.Count - 1)
    For n = 1 To .Rows.Count
        myrangearray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)
    Next
End With

[eduardodanon]

Thanks for your answer! And the MySlideArray?

Something like:

Dim n As Long

With tb.DataBodyRange
    ReDim myrangearray(.Rows.Count - 1)
    For n = 1 To .Rows.Count
        myrangearray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)
    Next
End With

[Aflatoon]

Where do the values for that come from? If they just start at 2 and increment, you don't need a separate array, just use x + 2 in your loop.

[snb]

you can use

sub M_snb()
  sn=cells(1).currentregion
end sub

or in a table

sub M_snb()
  sn=listobjects(1).databodyrange.value
end sub

sn is the array that contains the values.

[eduardodanon]

They increment from 2 to X, X being the total of slides.
So i would use the code above, is it correct?

ReDim myslidearray(.Rows.Count - 1)
For n = 2 To .Rows.Count
myslidearray(n - 1) = n ?

Where do the values for that come from? If they just start at 2 and increment, you don't need a separate array, just use x + 2 in your loop.

[Aflatoon]

Like this - no need for the array at all:

For x = LBound(MyRangeArray) To UBound(MyRangeArray)'Copy Excel Range
MyRangeArray(x).Copy


'Paste to PowerPoint and position
On Error Resume Next
Set shp = myPresentation.Slides(x + 2).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
On Error GoTo 0

[eduardodanon]

Im getting error "424" in line MyRangeArray(x).Copy
What am i doing wrong?

 
Dim MyRangeArray As Variant
Dim x As Long
Dim tb As ListObject
Dim c As Range
Dim osld As Slide
Dim I As Integer
Dim z As Integer
Dim n As Long

Set tb = Worksheets("Home").ListObjects("tblCopy")
    With tb.DataBodyRange
    ReDim MyRangeArray(.Rows.Count - 1)
        For n = 1 To .Rows.Count
            MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)
        Next
    End With
 (...)

For x = LBound(MyRangeArray) To UBound(MyRangeArray)
    'Copy Excel Range
        MyRangeArray(x).Copy
    
    'Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(x + 2).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
      On Error GoTo 0

Like this - no need for the array at all:

For x = LBound(MyRangeArray) To UBound(MyRangeArray)'Copy Excel Range
MyRangeArray(x).Copy


'Paste to PowerPoint and position
On Error Resume Next
Set shp = myPresentation.Slides(x + 2).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
On Error GoTo 0

[Aflatoon]

This line:

MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)

should be:

Set MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)

[eduardodanon]

AEEEEEEE it worked! thanks!!

This line:

MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)

should be:

Set MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)

[eduardodanon]

Hello again, if i want to include a third column in the table for the user to insert the slide number to paste the ranges (if the slides do not follow the "1,2,3,etc" sequence) what would i have to do? i tried adding MySlideArray like the following, but i dont know how to change the "set shp (...)". Can you help me, please?

Set tb = Worksheets("Home").ListObjects("tblCopy")
With tb.DataBodyRange
    ReDim MyRangeArray(.Rows.Count - 1)
    ReDim MySlideArray(.Rows.Count - 1)
    For n = 1 To .Rows.Count
        Set MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value)
        Set MySlideArray(n - 1) = Worksheets(.Cells(n, 3).Value)
    Next
End With
Set shp = myPresentation.Slides(MySlideArray(x + 1)).Shapes.PasteSpecial(DataType:=2)

[eduardodanon]

Can someone help me, please?

[Aflatoon]

Assuming the cells just contain numbers:

MySlideArray(n - 1) = .Cells(n, 3).Value

[eduardodanon]

I have tried that, but has not worked. it copies the range, but does not paste it.
i think im making error in this line:

Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010

Assuming the cells just contain numbers:

MySlideArray(n - 1) = .Cells(n, 3).Value

[Aflatoon]

I can't see a copy line in the code you posted.

[eduardodanon]

sorry, its because i didnot post the complete code. here it is:

On Error Resume Next 
Sheets("Home").Visible = True 
TotalSlides = Range("I1").Value 
 
Set tb = Worksheets("Home").ListObjects("tblCopy") 
With tb.DataBodyRange 
    ReDim MyRangeArray(.Rows.Count - 1) 
     
    For n = 1 To .Rows.Count 
        Set MyRangeArray(n - 1) = Worksheets(.Cells(n, 1).Value).Range(.Cells(n, 2).Value) 
         
    Next 
End With 
 
(...) 
 
 'Make PowerPoint Visible and Active
PowerPointApp.ActiveWindow.Panes(2).Activate 
 
 'Create a New Presentation
Set myPresentation = PowerPointApp.ActivePresentation 
 'Loop through Array data
For x = LBound(MyRangeArray) To UBound(MyRangeArray) 
     'Copy Excel Range
     
    MyRangeArray(x).Copy 
     
     'Paste to PowerPoint and position
    On Error Resume Next 
    Set shp = myPresentation.Slides(x + 2).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
     '  Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
    On Error GoTo 0