PDA

View Full Version : [SOLVED] Variable Array based on cell value



eduardodanon
11-03-2015, 04:25 AM
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
11-03-2015, 05:17 AM
If the table only contains populated cells in that column:

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

eduardodanon
11-03-2015, 05:42 AM
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
11-03-2015, 06:07 AM
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
11-03-2015, 06:13 AM
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
11-03-2015, 06:21 AM
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
11-03-2015, 06:27 AM
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
11-03-2015, 06:38 AM
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
11-03-2015, 06:44 AM
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
11-03-2015, 06:56 AM
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
11-03-2015, 07:00 AM
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
11-03-2015, 08:14 AM
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
11-03-2015, 08:28 AM
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
11-03-2015, 08:39 AM
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
11-04-2015, 07:29 AM
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
11-05-2015, 03:51 AM
Can someone help me, please?

Aflatoon
11-06-2015, 01:09 AM
Assuming the cells just contain numbers:

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

eduardodanon
11-06-2015, 04:36 AM
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
11-06-2015, 04:57 AM
I can't see a copy line in the code you posted.

eduardodanon
11-06-2015, 05:00 AM
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

Aflatoon
11-06-2015, 05:13 AM
That's the old code. Can you post the latest code you were trying?

eduardodanon
11-06-2015, 05:24 AM
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)
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)
MySlideArray(n - 1) = .Cells(n, 3).Value 'PS: it did not work with "set" either.

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(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
' Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
On Error GoTo 0

eduardodanon
11-06-2015, 05:31 AM
ahhhhhh i've just closed and opened the excel and ppt, and it worked! Many Thanks again! I hope not to disturb you again kkk
thanks!