Using Vlookup to set ranges for Loop, not sure how to integrate it.

[Jschroeder]

Hi All, I have a piece of code that loops through my workbook and cuts and pastes a range to PowerPoint. What I need to do is have it use Vlookup (or something like that) to see what sheet it is currently on, and lookup the range for that sheet, then use it. My code is below. I've had some help elsewhere with this code so I am by no means and expert or even intermediate.
The other issue is it is creating the slides backwards from the spreadsheet.
Thanks in advance.
J.

Sub LoopThroughSheets()
Dim ws As Worksheet, ppapp As PowerPoint.Application, PPShapeRange As PowerPoint.ShapeRange, _
psheet, pppres, newslide, slideid
Set ppapp = New PowerPoint.Application
ppapp.Visible = True
ppapp.Presentations.Open ("J:\51+Quoting Project\JS Template\2016_Renewal_Report_2.pptm")

With ThisWorkbook.Worksheets("Sheet1")
        sTxt1 = .Range("D4").Value
        sTxt2 = .Range("D5").Value
    End With
    
    With ppapp.ActivePresentation.Slides(1)
        .Shapes("TextBox 3").TextFrame.TextRange.Text = sTxt2
        '.TextBox 3.Value = Format(sTxt2, "mmmm" "dd", "yyyy")
        .Shapes("TextBox 3").TextFrame.TextRange.Text = Format(sTxt2, "mmmm d, yyyy")
        .Shapes("TextBox 2").TextFrame.TextRange.Text = sTxt1
    End With

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Then
    'do nothing
    Else
        If ws.Visible = True Then
            ws.Activate
            Set pppres = ppapp.ActivePresentation
            Set psheet = ActiveSheet
            Set newslide = pppres.Slides(10).Duplicate
            With newslide
                .Shapes.Title.TextFrame.TextRange.Text = "2016 Renewal – " & psheet.[B41]
                .SlideShowTransition.Hidden = msoFalse
                .Name = [B42]
            End With
            slideid = [B42]
            psheet.Range("A4:AC32").CopyPicture Appearance:=xlScreen, Format:=xlPicture
            '  Paste the range and align it
            Set PPShapeRange = pppres.Slides(slideid).Shapes.Paste
            With PPShapeRange
                .Height = 320
                .Align AlignCmd:=msoAlignCenters, RelativeTo:=True
                .Align AlignCmd:=msoAlignMiddles, RelativeTo:=True
            End With
        End If
        'On Error Resume Next
        ws.[B42] = ws.Name
               
           
    End If
   
Next ws
Sheets("Sheet1").Activate
MsgBox "Completed Successfully!", vbOKOnly + vbInformation
End Sub

[offthelip]

One way which I think could be quite an easy way to set this up, is to use a named range for each worksheet, and use the same name for the named range as the worksheet. Then you can then refer to the range as below:

[VBA]nam = ActiveSheet.Name
Range(nam).Select
[/VBA]

[Jschroeder]

I like this idea, I'll give it a shot, thank you for your response. I'll let you know how it goes.

[Jschroeder]

I ran into a problem, The sheet names have spaces in them and parenthesis, Range names don't allow spaces or parenthesis. And there is about 50 of them.

[Jschroeder]

OK I found a work around, I changed "nam" to reference a cell and populated that cell with the range. Its not pretty, but it works.

nam = ActiveSheet.[b44]
Range(nam).CopyPicture Appearance:=xlScreen, Format:=xlPicture

Thank you for your help!

[p45cal]

Named ranges have a scope, either worksheet or workbook. This means you can use the same name multiple times in the same workbook to refer to different ranges (each on a different worksheet).
To demonstrate this I'll set up a random range on each sheet and give it the name Hello; for example, run blah once:

Sub blah()
For Each ws In Sheets
  ws.Cells(Application.RandBetween(1, 10), Application.RandBetween(1, 10)).Resize(Application.RandBetween(1, 10), Application.RandBetween(1, 10)).Name = "'" & ws.Name & "'!Hello"
Next ws
End Sub

To show that Hello refers to different ranges on each sheet:

Sub blah2()
For Each ws In Sheets
  Application.Goto ws.Range("Hello")
  MsgBox "The 'Hello' range on this sheet (" & ws.Name & ") is selected."
Next ws
End Sub

or:

Sub blah3()
For Each ws In Sheets
  ws.Activate
  Range("Hello").Select
  MsgBox "The 'Hello' range on this sheet (" & ws.Name & ") is selected."
Next ws
End Sub

You'll see all the names in Name Manager.

You don't need to define the names programatically, you can use Name Manager to do that; just make sure you select a sheet for the scope in the New Name dialogue box.

[p45cal]

The other issue is it is creating the slides backwards from the spreadsheet.

I'm not very familiar with PowerPoint vba but I'd examine this line:

Set newslide = pppres.Slides(10).Duplicate

Does it insert a slide before the one it's duplicating? If you can find a way to reposition that slide to after the last slide that should solve it, but if you can't, you could run backwards through the sheets; adapting code from my last msg:

Sub blah3()
For i = Worksheets.Count To 1 Step -1
  Set ws = Worksheets(i)
  If ws.Visible Then
    ws.Activate
    Range("Hello").Select
    MsgBox "The 'Hello' range on this sheet (" & ws.Name & ") is selected."
  End If
Next i
End Sub

edit post posting:
I see from googling that there is a MoveTo method in Powerpoint vba, so inside your With newslide..End With you could perhaps have:

.MoveTo toPos:=.Parent.Slides.Count

to make it the last slide.
I'm really not sure.

[Jschroeder]

Named ranges have a scope, either worksheet or workbook. This means you can use the same name multiple times in the same workbook to refer to different ranges (each on a different worksheet).

I never even considered this, I'll probably change it to this so I don't have to use the "Helper" cells. Thanks so much!

[Jschroeder]

I see from googling that there is a MoveTo method in Powerpoint vba, so inside your With newslide..End With you could perhaps have:

.MoveTo toPos:=.Parent.Slides.Count

to make it the last slide.
I'm really not sure.

This is essentially what I ended up doing, Thanks again for your help!