Jump to content
News Ticker
  • Welcome to the Community
  • Use the forum to troubleshoot your Excel & VBA Problems
  • We will be launching a new website soon! www.ExcelWTF.com/Learn ! Join us to learn VBA from the ground up!
  • 0
RareNasturtium

Copy data from Excel to PowerPoint slides/tables

Question

Thanks in advance for taking a look at my problem.

 

I’m sending three files.  My data file, my presentation LINKED file, and my preferred presentation file named presentation.

 

I only want to copy visible data from any of the columns where data is being copied. The number of rows of data will vary each time on all the worksheets.

 

In the Excel file you will see several worksheets.  The first worksheet named "Industries" is where I drop my raw data from the web. The subsequent worksheets contain the data sorted with various filters.  I have a macro to reapply the filters to all the worksheets after new data is entered in “Industries”.  I’ve automated some of the process to have the data auto populate in the PowerPoint presentation.

 

I would prefer to copy the data...just the values and paste them to PowerPoint. I want to eliminate the Excel Worksheet Objects(presentation LINKED) and just copy the data to an existing PowerPoint slide/table(presentation).  On the Job's worksheet there is data in column L and N that I want to transfer to PowerPoint slide 2 presentation file.  Right now I have it automated with a linked Excel Worksheet Object in presentation LINKED.  I would prefer to just copy and paste the data to an existing table in PowerPoint file presentation slide 2.  I have the data formatted in Excel and I just want to copy to PowerPoint slide 2 into the existing table.

 

I want to copy the values from the "Change" worksheet in column L and O to PowerPoint slide 3. Not the headers.  The headers already exist in the destination table on slide 3.

 

I want to copy the values from "LQ>1.2" Column L to O to slide 5. Not the headers.

 

I want to copy the values from "LQ<0.8" column L to O to slide 6. Not the headers.

 

I want to copy the text from Competitive Strength worksheet column L to PowerPoint slide 8. Not the header.

 

I want to copy the text from Important to Retain worksheet column L to PowerPoint slide 11. Not the header.

 

I want to copy the text from Competitive Weakness worksheet column L to PowerPoint slide 14. Not the header.

 

I want to copy the text from Emerging Industries worksheet column L to PowerPoint slide 15. Not the header.

 

I want to copy the values from "4 Level NAICS LQ>1.2" columns K through O to slides 19 onward with 15 rows of data on each slide.  Not the headers.  The destination tables already contain headers.

 

Please let me know if you need clarification on anything before proceeding.  If it’s too complicated, please let me know and I can suggest an alternative.  I thank you for taking the time to look at it.

 

Nast

Share this post


Link to post
Share on other sites

Recommended Posts

  • 0

Hi Nast, 

 

Sorry, totally missed that. I had added a line of code to clear exiting text when the macro is run. I had it referencing the wrong Shape (should be shape2, not shape1 which is your title). Made the adjustment to the 3 macros below.

Sub Update_Slide11_AddText()
Dim wsRetain As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsRetain = Worksheets("Important to Retain")
Set wsTemp = Sheets.Add(After:=wsRetain)
Set appPPT = CreateObject("Powerpoint.application")

wsRetain.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(11).Shapes(2).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(11).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Update_Slide14_AddText()
Dim wsCompWeak As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsCompWeak = Worksheets("Competitive Weakness")
Set wsTemp = Sheets.Add(After:=wsCompWeak)
Set appPPT = CreateObject("Powerpoint.application")

wsCompWeak.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(14).Shapes(2).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(14).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Update_Slide15_AddText()
Dim wsEmerge As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsEmerge = Worksheets("Emerging Industries")
Set wsTemp = Sheets.Add(After:=wsEmerge)
Set appPPT = CreateObject("Powerpoint.application")

wsEmerge.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(15).Shapes(2).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(15).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

 

Let me know if the full module is now performing correctly :)

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hello Nast, 

 

Thanks for the question, and thanks for taking the time to explain the problem in such detail! I have also received your excel files and presentation files to work with and test things out.

 

You have listed a series of challenges, each of which I will tackle 1-by-1. I'm getting started on it now, So I will get back to you when I have completed 1 or more of the tasks on your list  :D

 

Regards

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hello Nast, 

 

I've been working on the following request.

Problem #2: I want to copy the values from the "Change" worksheet in column L and O to PowerPoint slide 3. Not the headers.  The headers already exist in the destination table on slide 3. 

 

I've not worked with Powerpoint and VBA, so needed to do some reading hehe :D . However, I can now successfully get it to import data from the change sheet to the table already in the Presentation. I have a couple questions though. 

  1. The table in the Presentation currently has 12 rows. The change worksheet has 14 values. So what do you want to do? add more rows to the Presentation title? or carry across the first 12 entries only?
  2. Are the number of rows to copy from the Change sheet going to vary over time? ie. not always 14 rows?

 

Let me know

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hey Cal,

 

1.  It's okay to carry over whatever number of entries exist on the change worksheet. I can always do some minor formatting tweaks after the information is in the presentation file...if necessary.

 

2.  The number of rows will change every single time.  Oh the joys of working with data! lol

 

Thanks again Cal!

Share this post


Link to post
Share on other sites
  • 0

Hello Nast

 

Thanks for the additional information. I now have a working solution for you. Some caveats:

  1. Add the SUB and Function to a new module in your data workbook
  2. The Presentation file (not the LINKED one) has to be already open when you run the macro. 

 

 

Sub ExtractSlide3Table()
'Purpose: Extract Date from Change Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Dim wsChange As Worksheet, wsTemp As Worksheet
Dim LR As Long, i As Long, j As Long, rCount As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsChange = Worksheets("Change")
Set wsTemp = Sheets.Add(After:=wsChange)
Set appPPT = CreateObject("Powerpoint.application")

wsChange.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

rCount = RowCount_ExistingTable(3, 2)
LR = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
    
If LR - 1 > rCount Then 'The existing table doesnt have enough rows
    If LR - 1 - rCount = 1 Then
        appPPT.ActivePresentation.Slides(3).Shapes(2).Table.Rows.Add (2)
    Else
        For a = 1 To LR - 1 - rCount
            appPPT.ActivePresentation.Slides(3).Shapes(2).Table.Rows.Add (2)
        Next a
    End If
End If

On Error Resume Next
For i = 2 To LR
    For j = 1 To 2
        appPPT.ActivePresentation.Slides(3).Shapes(2).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
End Sub

Function RowCount_ExistingTable(SlideNo As Long, ShapeNo As Long) As Long
Dim rCount As Long, x As Long
Dim appPPT As PowerPoint.Application
Set appPPT = CreateObject("Powerpoint.application")

For x = 2 To 100
    On Error GoTo found
    appPPT.ActivePresentation.Slides(SlideNo).Shapes(ShapeNo).Table.Cell(x, 1).Shape.TextFrame.TextRange.Text = "Test"
Next x

found:
RowCount_ExistingTable = x - 2

End Function

 

This is working for me on my end. Could you please test on your machine and let me know how it goes. The majority of your other requirements are similar to this one, so I'll wait to hear back from you before writing solutions for the others.

 

Many Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Nast, 

 

Sorry I should have mentioned.... you need to add the Powerpoint Reference to get this working also. In your excel file, after you have added the code to a new module.

 

Go to the VBA Editor (ALT + F11)

Click the Tools Menu > References

Select the Microsoft Powerpoint Object

 

k0ssr6.jpg

 

Sorry about that, let me know if the code works :)

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Thanks Cal!  Glad you mentioned the PowerPoint Reference!

 

Outstanding!  That is precisely what I was wanting it to do.  I just wanted to copy the data!  Perfect.

 

If we could do that same thing with the other pages in the initial request...that would be awesome!

 

Thanks so much.

 

I seriously need to learn VBA.  You are the guru!

 

Nast

Share this post


Link to post
Share on other sites
  • 0

Hi Nast, 

 

That's great! Thanks for the positive feedback, I'm glad it worked. I've not done any VBA for Powerpoint, so I got the chance to learn something new :D

 

Yeah sure, i'll code the other parts of your request. I am going to have a play around with it. It looks like your first 4 requests are exactly the same (just different sheets, ranges, and slide numbers). Can probably just set up 1 function to deal with all 4 of them :) WIll be far less code in your module ;)

 

If you're keen on learning VBA. I would highly recommend checking out 'Wiseowl Tutorial' on Youtube. He's a great teacher, and that's how I learnt most of what i know!

 

Thanks

Caleeco 

Share this post


Link to post
Share on other sites
  • 0

Hi Nast, 

 

Doing some more work on this request. At the end of it, how do you intend on running the code? Do you want to update all the sheets at once, or would you rather it remain modular so you can update them one slide at a time?

 

Let me know

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hi Nast, 

 

The code below should address these problems.

Problem #1: On the Job's worksheet there is data in column L and N that I want to transfer to PowerPoint slide 2 presentation file

Problem #2: I want to copy the values from the "Change" worksheet in column L and O to PowerPoint slide 3. Not the headers.  The headers already exist in the destination table on slide 3.

Problem #3: I want to copy the values from "LQ>1.2" Column L to O to slide 5. Not the headers.

Problem #4: I want to copy the values from "LQ

 

I will tie it all together at the end, depending on your answer to the Question above.

Sub ExtractSlide2Table()
'Purpose: Extract Date from Jobs Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsJobs As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsJobs = Worksheets("Jobs")
Set wsTemp = Sheets.Add(After:=wsJobs)
Set appPPT = CreateObject("Powerpoint.application")

wsJobs.Range("L:N").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
 wsTemp.Range("B" & a) = CInt(wsTemp.Range("B" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(2, 2, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 2
        appPPT.ActivePresentation.Slides(2).Shapes(2).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub ExtractSlide3Table()
'Purpose: Extract Date from Change Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsChange As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsChange = Worksheets("Change")
Set wsTemp = Sheets.Add(After:=wsChange)
Set appPPT = CreateObject("Powerpoint.application")

wsChange.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
 wsTemp.Range("B" & a) = CInt(wsTemp.Range("B" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(3, 2, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 2
        appPPT.ActivePresentation.Slides(3).Shapes(2).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub ExtractSlide5Table()
'Purpose: Extract Date from LQ>1.2 Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsLQ12 As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsLQ12 = Worksheets("LQ>1.2")
Set wsTemp = Sheets.Add(After:=wsLQ12)
Set appPPT = CreateObject("Powerpoint.application")

wsLQ12.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
    wsTemp.Range("B" & a) = Round(wsTemp.Range("B" & a).Value, 2)
    wsTemp.Range("C" & a) = CInt(wsTemp.Range("C" & a).Value)
    wsTemp.Range("D" & a) = CInt(wsTemp.Range("D" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(5, 1, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 4
        appPPT.ActivePresentation.Slides(5).Shapes(1).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub ExtractSlide8Table()
'Purpose: Extract Date from LQ>1.2 Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsLQ08 As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsLQ08 = Worksheets("LQSet wsTemp = Sheets.Add(After:=wsLQ08)
Set appPPT = CreateObject("Powerpoint.application")

wsLQ08.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
    wsTemp.Range("B" & a) = Round(wsTemp.Range("B" & a).Value, 2)
    wsTemp.Range("C" & a) = CInt(wsTemp.Range("C" & a).Value)
    wsTemp.Range("D" & a) = CInt(wsTemp.Range("D" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(6, 1, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 4
        appPPT.ActivePresentation.Slides(6).Shapes(1).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Function ModifyRowNum_ExistingTable(SlideNo As Long, shapeNo As Long, lr As Long)
Application.ScreenUpdating = False
Dim x As Long, rcount As Long, a As Long
Dim appPPT As PowerPoint.Application
Set appPPT = CreateObject("Powerpoint.application")

For x = 2 To 100
    On Error GoTo found
    appPPT.ActivePresentation.Slides(SlideNo).Shapes(shapeNo).Table.Cell(x, 1).Shape.TextFrame.TextRange.Text = ""
Next x

found:
rcount = x - 2

If lr - 1 > rcount Then 'The existing table doesnt have enough rows
    If lr - 1 - rcount = 1 Then
        appPPT.ActivePresentation.Slides(SlideNo).Shapes(shapeNo).Table.Rows.Add (2)
    Else
        For a = 1 To lr - 1 - rcount
            appPPT.ActivePresentation.Slides(SlideNo).Shapes(shapeNo).Table.Rows.Add (2)
        Next a
    End If
End If

End Function

 

Let me know if it all works. you'll have to run each sub individually for now!

Share this post


Link to post
Share on other sites
  • 0

Progress! I can now update text boxes in Powerpoint too :D

Problem #5: I want to copy the text from Competitive Strength worksheet column L to PowerPoint slide 8. Not the header.

Problem #6: I want to copy the text from Important to Retain worksheet column L to PowerPoint slide 11. Not the header.

Problem #7: I want to copy the text from Competitive Weakness worksheet column L to PowerPoint slide 14. Not the header.

Problem #8: I want to copy the text from Emerging Industries worksheet column L to PowerPoint slide 15. Not the header.

 

Sub Slide8_AddText()
Dim wsCompStr As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsCompStr = Worksheets("Competitive Strength")
Set wsTemp = Sheets.Add(After:=wsCompStr)
Set appPPT = CreateObject("Powerpoint.application")

wsCompStr.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(8).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & "- " & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(8).Shapes(1).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Slide11_AddText()
Dim wsRetain As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsRetain = Worksheets("Important to Retain")
Set wsTemp = Sheets.Add(After:=wsRetain)
Set appPPT = CreateObject("Powerpoint.application")

wsRetain.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(11).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(11).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Slide14_AddText()
Dim wsCompWeak As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsCompWeak = Worksheets("Competitive Weakness")
Set wsTemp = Sheets.Add(After:=wsCompWeak)
Set appPPT = CreateObject("Powerpoint.application")

wsCompWeak.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(14).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(14).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Slide15_AddText()
Dim wsEmerge As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsEmerge = Worksheets("Emerging Industries")
Set wsTemp = Sheets.Add(After:=wsEmerge)
Set appPPT = CreateObject("Powerpoint.application")

wsEmerge.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(15).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(15).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

 

Let me know if it works on your end

Caleeco

Share this post


Link to post
Share on other sites
  • 0
Thanks Cal. That's amazing! Will have to test it on Monday.  I'd love to be able to update all the sheets at once. Great work!!

No problem, we're on the home stretch now! :D Just Problem #9 left to crack! I'll aim to have that one done by tomorrow. ;)

Cool, i'll follow up on Monday. If all the individual sub-routines are working, I'll tie them all together so you can update all with 1-click  :thumbup:

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hey Cal,

 

I tried the code for problem #5-8 and it looks great.  One small hiccup.

 

Problem #5: I want to copy the text from Competitive Strength worksheet column L to PowerPoint slide 8. Not the header.

Problem #6: I want to copy the text from Important to Retain worksheet column L to PowerPoint slide 11. Not the header.

Problem #7: I want to copy the text from Competitive Weakness worksheet column L to PowerPoint slide 14. Not the header.

Problem #8: I want to copy the text from Emerging Industries worksheet column L to PowerPoint slide 15. Not the header.

 

The code that's putting the text into slide 8 is putting it at the top of the page in black text.  All the other pages look fantastic!!  They are using white text and it's centred. It looks good.

 

I tried the code for the following too:

 

Problem #1: On the Job's worksheet there is data in column L and N that I want to transfer to PowerPoint slide 2 presentation file

Problem #2: I want to copy the values from the "Change" worksheet in column L and O to PowerPoint slide 3. Not the headers.  The headers already exist in the destination table on slide 3.

Problem #3: I want to copy the values from "LQ>1.2" Column L to O to slide 5. Not the headers.

Problem #4: I want to copy the values from "LQ<0.8" column L to O to slide 6. Not the headers

 

The code for Problem #1-4 works perfectly!

 

You da man!

 

Thanks!!!

 

Just problem 9 and tying them all together and it will be a masterpiece!!  Thanks again Cal.

 

Nast

Share this post


Link to post
Share on other sites
  • 0

Hi Nast,

 

Thanks for the feedback. So am I understanding correctly, from the ones I have posted solutions for... only Problem #5 is giving you that issue?

 

EDIT: I just checked, and yes... Slide 8 is not adding text to the correct shape. I have updated the code below:

Sub Slide8_AddText()
Dim wsCompStr As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsCompStr = Worksheets("Competitive Strength")
Set wsTemp = Sheets.Add(After:=wsCompStr)
Set appPPT = CreateObject("Powerpoint.application")

wsCompStr.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(8).Shapes(3).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(8).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

Hopefully that works! Let me know

 

Problem #9 is a tricky one. I can get it to split up data 15 rows at a time...  I just need to figure out the logic to make sure it fills up each row on each slide properly, then add new slides if need be. I'll work on it today, but it may take a day or two to test/finalise! Hopefully you'll hear back from me tomorrow evening :thumbup: 

Share this post


Link to post
Share on other sites
  • 0

Hi Nast!

Glad you're enjoying the WiseOwl Stuff... I think its top quality! 

 

My first crack at the infamous Problem #9 is here... I have run some tests, and it seems to work for me. This was a monster! But I think I got the coding logic correct :)

 

Could you please try on your end. 

Sub ExtractSlide19PlusTable()
'Purpose: Extract Date from 4 Level NAICS LQ>1.2 Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim ws4L As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long, ImportRows As Long, SpaceLeft As Long, TotalSlides As Long
Dim b As Long, counti As Long, x As Long, y As Long, c As Long
Dim appPPT As PowerPoint.Application

Set ws4L = Worksheets("4 Level NAICS LQ>1.2")
Set wsTemp = Sheets.Add(After:=ws4L)
Set appPPT = CreateObject("Powerpoint.application")

ws4L.Range("K:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row

For a = 2 To lr
    wsTemp.Range("C" & a) = Round(wsTemp.Range("C" & a).Value, 2)
    wsTemp.Range("D" & a) = CInt(wsTemp.Range("D" & a).Value)
    wsTemp.Range("E" & a) = CInt(wsTemp.Range("E" & a).Value)
Next a

TotalSlides = appPPT.ActivePresentation.Slides.Count

If TotalSlides = 20 Then
    appPPT.ActivePresentation.Slides(20).Delete
ElseIf TotalSlides > 20 Then
    For c = 1 To TotalSlides - 19
        appPPT.ActivePresentation.Slides(TotalSlides).Delete
        TotalSlides = appPPT.ActivePresentation.Slides.Count
    Next c
End If

On Error Resume Next
For i = 2 To 16
    For j = 1 To 5
        appPPT.ActivePresentation.Slides(19).Shapes(1).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = ""
    Next j
Next i

ImportRows = lr - 1
SpaceLeft = 15 * (TotalSlides - 18)

If ImportRows     'No Need to do anything
Else
    'We need to copy some sheets
    Do While SpaceLeft         appPPT.ActivePresentation.Slides(TotalSlides).Duplicate
    SpaceLeft = SpaceLeft + 15
    Loop
    TotalSlides = appPPT.ActivePresentation.Slides.Count
End If

x = 2
y = 1
b = 19

For i = 2 To lr
    For j = 1 To 5
        y = j
        appPPT.ActivePresentation.Slides(b).Shapes(1).Table.Cell(x, y).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
        x = x + 1
        If x = 17 Then
            x = 2
            b = b + 1
    End If
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

If all is well with this one, let me know... then I'll do a massive clean up on all 9 problems, and tie them together so you can update all slides with 1 button ;)

 

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0

OUTSTANDING Cal!  Simply outstanding!  It works beautifully!  You are a master of VBA!  Can't wait to see the finished product!  Job well done sir!

 

You need to have yourself on Facebook and Twitter!  I'm happy to send people here!

Share this post


Link to post
Share on other sites
  • 0
OUTSTANDING Cal!  Simply outstanding!  It works beautifully!  You are a master of VBA!  Can't wait to see the finished product!  Job well done sir!

 

You need to have yourself on Facebook and Twitter!  I'm happy to send people here!

Awesome! Glad it worked!  :D

I took your advice, just set up my Facebook & Twitter! Links can be found in the bottom left corner of the page (look for the Social Media icons). A shout out would be much appreciated  :thumbup: It will certainly help us build a bigger community  :D

Working on the code tidy up now, Might take an hour or so... so time to get some music on, and excel booted up! 

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Ok, I think we are finally there! One last round of testing. Below is your Master Macro which will trigger all the others. 

Sub Import_All_Data()
'Purpose: Extract Data from Worksheet and Update Multiple PowerPoint Slides
'Source: www.ExcelWTF.com

Application.ScreenUpdating = False

Call Update_Slide2_Jobs_Data
Call Update_Slide3_Change_Data
Call Update_Slide5_LQ12_Data
Call Update_Slide6_LQ08_Data
Call Update_Slide8_AddText
Call Update_Slide11_AddText
Call Update_Slide14_AddText
Call Update_Slide15_AddText
Call Update_Slide19_L4_NAICS

Application.ScreenUpdating = True

End Sub

 

So link this 1 macro to a button, or run it through the VBA editor. I chose leave it as a modular code (so if you need to make specific changes to any of the imported slides, it will be straight forward to do. I would advise commenting out all previous VBA i've supplied. Create a new module in your workbook, then paste this lot in and test!

Option Explicit

Sub Import_All_Data()
'Purpose: Extract Data from Worksheet and Update Multiple PowerPoint Slides
'Source: www.ExcelWTF.com

Application.ScreenUpdating = False

Call Update_Slide2_Jobs_Data
Call Update_Slide3_Change_Data
Call Update_Slide5_LQ12_Data
Call Update_Slide6_LQ08_Data
Call Update_Slide8_AddText
Call Update_Slide11_AddText
Call Update_Slide14_AddText
Call Update_Slide15_AddText
Call Update_Slide19_L4_NAICS

Application.ScreenUpdating = True

End Sub

Sub Update_Slide2_Jobs_Data()
'Purpose: Extract Date from Jobs Worksheet and Paste onto Slide 2
'Source: www.ExcelWTF.com
Dim wsJobs As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsJobs = Worksheets("Jobs")
Set wsTemp = Sheets.Add(After:=wsJobs)
Set appPPT = CreateObject("Powerpoint.application")

wsJobs.Range("L:N").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
 wsTemp.Range("B" & a) = CInt(wsTemp.Range("B" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(2, 2, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 2
        appPPT.ActivePresentation.Slides(2).Shapes(2).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i
Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
End Sub

Sub Update_Slide3_Change_Data()
'Purpose: Extract Data from Change Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsChange As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsChange = Worksheets("Change")
Set wsTemp = Sheets.Add(After:=wsChange)
Set appPPT = CreateObject("Powerpoint.application")

wsChange.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
 wsTemp.Range("B" & a) = CInt(wsTemp.Range("B" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(3, 2, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 2
        appPPT.ActivePresentation.Slides(3).Shapes(2).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub Update_Slide5_LQ12_Data()
'Purpose: Extract Date from LQ>1.2 Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsLQ12 As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsLQ12 = Worksheets("LQ>1.2")
Set wsTemp = Sheets.Add(After:=wsLQ12)
Set appPPT = CreateObject("Powerpoint.application")

wsLQ12.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
    wsTemp.Range("B" & a) = Round(wsTemp.Range("B" & a).Value, 2)
    wsTemp.Range("C" & a) = CInt(wsTemp.Range("C" & a).Value)
    wsTemp.Range("D" & a) = CInt(wsTemp.Range("D" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(5, 1, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 4
        appPPT.ActivePresentation.Slides(5).Shapes(1).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub Update_Slide6_LQ08_Data()
'Purpose: Extract Date from LQ'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim wsLQ08 As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long
Dim appPPT As PowerPoint.Application

Set wsLQ08 = Worksheets("LQSet wsTemp = Sheets.Add(After:=wsLQ08)
Set appPPT = CreateObject("Powerpoint.application")

wsLQ08.Range("L:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
For a = 2 To lr
    wsTemp.Range("B" & a) = Round(wsTemp.Range("B" & a).Value, 2)
    wsTemp.Range("C" & a) = CInt(wsTemp.Range("C" & a).Value)
    wsTemp.Range("D" & a) = CInt(wsTemp.Range("D" & a).Value)
Next a

Call ModifyRowNum_ExistingTable(6, 1, lr)

On Error Resume Next
For i = 2 To lr
    For j = 1 To 4
        appPPT.ActivePresentation.Slides(6).Shapes(1).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Function ModifyRowNum_ExistingTable(SlideNo As Long, shapeNo As Long, lr As Long)
Application.ScreenUpdating = False
Dim x As Long, rcount As Long, a As Long
Dim appPPT As PowerPoint.Application
Set appPPT = CreateObject("Powerpoint.application")

For x = 2 To 100
    On Error GoTo found
    appPPT.ActivePresentation.Slides(SlideNo).Shapes(shapeNo).Table.Cell(x, 1).Shape.TextFrame.TextRange.Text = ""
Next x

found:
rcount = x - 2

If lr - 1 > rcount Then 'The existing table doesnt have enough rows
    If lr - 1 - rcount = 1 Then
        appPPT.ActivePresentation.Slides(SlideNo).Shapes(shapeNo).Table.Rows.Add (2)
    Else
        For a = 1 To lr - 1 - rcount
            appPPT.ActivePresentation.Slides(SlideNo).Shapes(shapeNo).Table.Rows.Add (2)
        Next a
    End If
End If

End Function

Sub Update_Slide8_AddText()
Dim wsCompStr As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsCompStr = Worksheets("Competitive Strength")
Set wsTemp = Sheets.Add(After:=wsCompStr)
Set appPPT = CreateObject("Powerpoint.application")

wsCompStr.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(8).Shapes(3).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(8).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Update_Slide11_AddText()
Dim wsRetain As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsRetain = Worksheets("Important to Retain")
Set wsTemp = Sheets.Add(After:=wsRetain)
Set appPPT = CreateObject("Powerpoint.application")

wsRetain.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(11).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(11).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Update_Slide14_AddText()
Dim wsCompWeak As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsCompWeak = Worksheets("Competitive Weakness")
Set wsTemp = Sheets.Add(After:=wsCompWeak)
Set appPPT = CreateObject("Powerpoint.application")

wsCompWeak.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(14).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(14).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Update_Slide15_AddText()
Dim wsEmerge As Worksheet, wsTemp As Worksheet
Dim Text2Paste As String
Dim lr As Long, i As Long
Dim appPPT As PowerPoint.Application

Set wsEmerge = Worksheets("Emerging Industries")
Set wsTemp = Sheets.Add(After:=wsEmerge)
Set appPPT = CreateObject("Powerpoint.application")

wsEmerge.Range("L:L").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("A" & Rows.Count).End(xlUp).Row
appPPT.ActivePresentation.Slides(15).Shapes(1).TextFrame.TextRange.Text = ""

For i = 2 To lr
Text2Paste = Text2Paste & wsTemp.Range("A" & i).Value & vbCr
Next i

appPPT.ActivePresentation.Slides(15).Shapes(3).TextFrame.TextRange.Text = Text2Paste

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Update_Slide19_L4_NAICS()
'Purpose: Extract Date from 4 Level NAICS LQ>1.2 Worksheet and Paste Directly into PPT Slide
'Source: www.ExcelWTF.com
Application.ScreenUpdating = False
Dim ws4L As Worksheet, wsTemp As Worksheet
Dim lr As Long, i As Long, j As Long, a As Long, ImportRows As Long, SpaceLeft As Long, TotalSlides As Long
Dim b As Long, counti As Long, x As Long, y As Long, c As Long
Dim appPPT As PowerPoint.Application

Set ws4L = Worksheets("4 Level NAICS LQ>1.2")
Set wsTemp = Sheets.Add(After:=ws4L)
Set appPPT = CreateObject("Powerpoint.application")

ws4L.Range("K:O").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

lr = wsTemp.Range("B" & Rows.Count).End(xlUp).Row

For a = 2 To lr
    wsTemp.Range("C" & a) = Round(wsTemp.Range("C" & a).Value, 2)
    wsTemp.Range("D" & a) = CInt(wsTemp.Range("D" & a).Value)
    wsTemp.Range("E" & a) = CInt(wsTemp.Range("E" & a).Value)
Next a

TotalSlides = appPPT.ActivePresentation.Slides.Count

If TotalSlides = 20 Then
    appPPT.ActivePresentation.Slides(20).Delete
ElseIf TotalSlides > 20 Then
    For c = 1 To TotalSlides - 19
        appPPT.ActivePresentation.Slides(TotalSlides).Delete
        TotalSlides = appPPT.ActivePresentation.Slides.Count
    Next c
End If

On Error Resume Next
For i = 2 To 16
    For j = 1 To 5
        appPPT.ActivePresentation.Slides(19).Shapes(1).Table.Cell(i, j).Shape.TextFrame.TextRange.Text = ""
    Next j
Next i

ImportRows = lr - 1
SpaceLeft = 15 * (TotalSlides - 18)

If ImportRows     'No Need to do anything
Else
    'We need to copy some sheets
    Do While SpaceLeft         appPPT.ActivePresentation.Slides(TotalSlides).Duplicate
    SpaceLeft = SpaceLeft + 15
    Loop
    TotalSlides = appPPT.ActivePresentation.Slides.Count
End If

x = 2
y = 1
b = 19

For i = 2 To lr
    For j = 1 To 5
        y = j
        appPPT.ActivePresentation.Slides(b).Shapes(1).Table.Cell(x, y).Shape.TextFrame.TextRange.Text = wsTemp.Cells(i, j)
    Next j
        x = x + 1
        If x = 17 Then
            x = 2
            b = b + 1
    End If
Next i

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

Remember, you only need to run the Sub Import_All_Data() macro

 

Let me know if it all works

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hey Cal,

 

It looks absolutely amazing!

 

I'm having one small glitch.  When I run the macro it seems to be removing my titles from slide 11, 14, and 15.  Not sure why.  Other than that.  Runs beautifully!!!

 

I posted your site details on my Facebook and Twitter.  I'm singing your praises all over the net! lol

 

Nast

Share this post


Link to post
Share on other sites
  • 0
Hey Cal,

 

It looks absolutely amazing!

 

I'm having one small glitch.  When I run the macro it seems to be removing my titles from slide 11, 14, and 15.  Not sure why.  Other than that.  Runs beautifully!!!

 

I posted your site details on my Facebook and Twitter.  I'm singing your praises all over the net! lol

 

Nast

hehe thank you for the Social Media Promotion it is very much appreciated!  :clap:

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...