Sub Data_Export_From_Excel_To_PPT()
'Declare Object varaible for - Powerpoint Application
Dim PPTApp As PowerPoint.Application
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True
PPTApp.Activate

'Declare Object variable for - PowerPoint Presentation
Dim Presentation As PowerPoint.Presentation
Set Presentation = PPTApp.Presentations.Add

'Declare Object variable for - Powerpoint Slide
Dim PPTSlide As PowerPoint.Slide
SlideNumber = 1

'Define the workbook
Dim WKB As Workbook
Set WKB = ActiveWorkbook

'Define the Worksheet
Dim InputSh As Worksheet
Set InputSh = WKB.Sheets("InputSheet")

'Clear Content for Status column
Dim LastRowForStatus As Integer
LastRowForStatus = InputSh.Range("F" & Rows.Count).End(xlUp).Row
If LastRowForStatus <> 1 Then
InputSh.Range(Cells(2, 6), Cells(LastRowForStatus, 6)).ClearContents
End If

'Define Last Row
Dim LastRow As Integer
LastRow = InputSh.Range("A" & Rows.Count).End(xlUp).Row
Dim R As Integer
For R = 2 To LastRow
Set PPTSlide = Presentation.Slides.Add(SlideNumber, ppLayoutBlank)
PPTSlide.Shapes.AddPicture Filename:=InputSh.Cells(R, 1).Value, LinkToFile:=msoTrue, _
SaveWithDocument:=msoTrue, _
Left:=InputSh.Cells(R, 2).Value, _
Top:=InputSh.Cells(R, 3).Value, _
Height:=InputSh.Cells(R, 4).Value, _
Width:=InputSh.Cells(R, 5).Value

InputSh.Cells(R, 6).Value = "Image Exported"
SlideNumber = SlideNumber + 1
Next

MsgBox "Automation Completed"

End Sub