Selecting a cell in excel.

[ifu06416]

Hi there,

I'm trying to merge two blocks of code I've found online but having a bit of difficulty.

I am looking to set a powerpoint doc to automatically run a marco when opened. The macro should open an excel workbook and record the users info before saving and closing it.

Both blocks of code (one to open the wb and the second to record user details) work independently but not when merged. The issue seems to be around selecting cell A1 once the workbook (User Log record) is open.

Sub macro2()

'BLOCK 1 - OPEN WORKBOOK
Dim xlApp As Object
Dim xlBook As Object
Const strWorkbookName As String = "C:\Users\John\OneDrive\Documents\Macros\User Log record.xlsx" 'the name and path of the workbook

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
    xlApp.Visible = True
lbl_Exit:
    Set xlApp = Nothing
    Set xlBook = Nothing
    'Exit Sub
    
' BLOCK 2 - RECORD USER DETILS
    Range("A1").Select
    ActiveCell.End(xlDown).Offset(1, 0).Select
    ActiveCell.Value = Application.USerName
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Template 2"
    ActiveCell.Offset(0, 1).Select
    ActiveCell = Date
    ActiveCell.Offset(0, 1).Select
    ActiveCell = Time

    
    ActiveWorkbook.Close SaveChanges:=True

End Sub

 

[Zot]

I believe it is because you prematurely set xlApp and xlBook to Nothing. It is also good to have reference to Range("A1") or anything to code. Otherwise it can refer to any opened workbook thus causing error.

Not sure if this work but try this

Sub macro2()

'BLOCK 1 - OPEN WORKBOOK
Dim xlApp As Object
Dim xlBook As Object
Const strWorkbookName As String = "C:\Users\John\OneDrive\Documents\Macros\User Log record.xlsx" 'the name and path of the workbook

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(Filename:=strWorkbookName)
    xlApp.Visible = True
lbl_Exit:
    
' BLOCK 2 - RECORD USER DETILS
    With xlBook
        Range("A1").Select
        ActiveCell.End(xlDown).Offset(1, 0).Select
        ActiveCell.Value = Application.UserName
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Template 2"
        ActiveCell.Offset(0, 1).Select
        ActiveCell = Date
        ActiveCell.Offset(0, 1).Select
        ActiveCell = Time
    End With
    
    xlBook.Close SaveChanges:=True
    Set xlApp = Nothing
    Set xlBook = Nothing

End Sub

Try to avoid using Select unless really necessary. Maybe something like this

With xlBook.Range("A1").End(xlDown).Offset(1, 0)
    .Value = Application.UserName
    .Offset(0, 1).Value = "Template 2"
    .Offset(0, 2) = Date
    .Offset(0, 3) = Time
End With

 

[ifu06416]

Hi there,

These two solutions dont seem to work.

When I use the first code suggested i get sub or function not defined error triggered by the line Range("A1").Select

Sub macro2()

'BLOCK 1 - OPEN WORKBOOK
Dim xlApp As Object
Dim xlBook As Object
Const strWorkbookName As String = "C:\Users\John\OneDrive\Documents\Macros\User Log record.xlsx" 'the name and path of the workbook

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
    xlApp.Visible = True
lbl_Exit:
    
' BLOCK 2 - RECORD USER DETILS
    With xlBook
        Range("A1").Select
        ActiveCell.End(xlDown).Offset(1, 0).Select
        ActiveCell.Value = Application.UserName
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Template 2"
        ActiveCell.Offset(0, 1).Select
        ActiveCell = Date
        ActiveCell.Offset(0, 1).Select
        ActiveCell = Time
    End With
    
    xlBook.Close SaveChanges:=True
    Set xlApp = Nothing
    Set xlBook = Nothing
 

End Sub

When I substitute in the second block of code I get the method or data member not found error regarding UserName

Sub macro2()

'BLOCK 1 - OPEN WORKBOOK
Dim xlApp As Object
Dim xlBook As Object
Const strWorkbookName As String = "C:\Users\John\OneDrive\Documents\Macros\User Log record.xlsx" 'the name and path of the workbook

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
    xlApp.Visible = True
lbl_Exit:
    
' BLOCK 2 - RECORD USER DETILS

With xlBook.Range("A1").End(xlDown).Offset(1, 0)
    .Value = Application.UserName
    .Offset(0, 1).Value = "Template 2"
    .Offset(0, 2) = Date
    .Offset(0, 3) = Time
End With

    xlBook.Close SaveChanges:=True
    Set xlApp = Nothing
    Set xlBook = Nothing
 

End Sub

Regards,

John.

 

[Zot]

Sorry. I did not test he code.

Since you need to have full Excel macro from within PowerPoint, you need to add reference to it. Go to Tools > References and add (tick) Microsoft Excel 1x.0 Object Library (depends on your Excel version)

Sub macro2()

Dim xlApp As Object
Dim xlBook As Object

Const strWorkbookName As String = "C:\Users\John\OneDrive\Documents\Macros\User Log record.xlsx" 'the name and path of the workbook

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
    Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
xlApp.Visible = True

With xlBook.Sheets("Sheet1").Range("A1").End(xldown).Offset(1, 0)
    .Value = xlBook.Application.UserName
    .Offset(0, 1).Value = "Template 2"
    .Offset(0, 2) = Date
    .Offset(0, 3) = Time
End With
    
xlBook.Close SaveChanges:=True
Set xlApp = Nothing
Set xlBook = Nothing

End Sub

 

[ifu06416]

Sorry. I did not test he code.

Since you need to have full Excel macro from within PowerPoint, you need to add reference to it. Go to Tools > References and add (tick) Microsoft Excel 1x.0 Object Library (depends on your Excel version)

Sub macro2()

Dim xlApp As Object
Dim xlBook As Object

Const strWorkbookName As String = "C:\Users\John\OneDrive\Documents\Macros\User Log record.xlsx" 'the name and path of the workbook

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
    Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
xlApp.Visible = True

With xlBook.Sheets("Sheet1").Range("A1").End(xldown).Offset(1, 0)
    .Value = xlBook.Application.UserName
    .Offset(0, 1).Value = "Template 2"
    .Offset(0, 2) = Date
    .Offset(0, 3) = Time
End With
   
xlBook.Close SaveChanges:=True
Set xlApp = Nothing
Set xlBook = Nothing

End Sub

Ah there we go :D

Thanks Zot.

 

[Zot]

Ah there we go :D

Thanks Zot.

Thanks for asking the question. I also learned something here and there trying to solve your problem