VBA to Find First Empty Cell in a Row and Insert Text

Ballen

New member
Local time
Yesterday, 22:50
Joined
Sep 20, 2012
Messages
3
Hello -

Hoping someone can help me with my translation of Excel VBA to Access. I'm using Access to export the results of a query to Excel and within the same code I am opening up the spreadsheet to format it. Part of the formatting requires me to find the first empty cell in column A, and then insert the text 'Summary'.

Within Excel, the following code works:
Find empty cell:
Code:
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

Add term 'Summary' to cell:
Code:
ActiveCell.FormulaR1C1 = "Summary"

I've tried a few different things based on some code I've found on the net from similar situations, but in just about all attempts I get an object defined error. I've tried dimming the piece of code as an object, but when it comes to VBA, I'm just fumbling through.

Any help would be greatly appreciated.

Thanks
 
Thanks. I'll try that for that piece, but I should have mentioned that it first error's out when trying to find the first blank cell.

I've tried many variations of the following:
Code:
xlSheet.Range("A" & rows.Count).end(xlup).offset(1, 0)

Tried defining it as an object:
Code:
Dim xlBlankCell As Object
 
Set xlBlankCell = xlSheet.Range("A" & .Rows.Count).end(xlup).offset(1, 0).select
xlBlankCell.Activate
ActiveCell.Value = "Summary"

Appreciate the response and any additional help.
 
Can you post the full code - how are you declaring your Excel objects.
 
You should have something like this before you start trying to call the xlSheet:
Code:
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
If Err.Number > 0 Then  'Excel was not open
    Set objXL = New Excel.Application
End If
 
Set objWB = objXL.Workbooks.Open(FilePath & FileName)
objXL.Visible = True
Set objSht = objWkb.Worksheets(1)
objSht.Activate
 
I do have the other objects referenced. Below is the working code prior to me trying to find the last cell and insert the text:

Code:
Function ExportPMC()
 
'Exports both the 'Today's Prices and Rates - Output' table to an Excel spreadsheet titled 'Prices and Rates - MM-DD-YYYY.xlsx' using the current date
 
Dim mnth As String
Dim dy As String
Dim yr As String
Dim file_nme As String
mnth = Month(Now())
dy = Day(Now())
yr = Year(Now())
 
'Define file name using the current date within the name
 
file_nme = "\\Output\Today\Prices and Rates - " + mnth + "-" + dy + "-" + yr + ".xlsx"
 
'Exports Today's Prices and Rates - Output' table to the Excel spreadsheet
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Today's Prices and Rates - Output", [file_nme]
 
'Variables to refer to Excel and Objects
 
Dim MySheetPath As String
Dim xl As Object
Dim xlBook As Object
Dim xlSheet As Object
 
'Disables Error Handling
'On Error Resume Next
 
'Location of Excel File - Name Changes due to Date Variable
MySheetPath = file_nme
 
'Open Excel and the workbook
Set xl = CreateObject("Excel.Application")
Set xlBook = xl.Workbooks.Open(file_nme)
 
'Set Excel to be visible on screen
xl.Visible = True
 
'Define the active sheet (sheet 1) in the Workbook as XlSheet
Set xlSheet = xlBook.Worksheets(1)
 
'Formatting of sheet 1 - Deletes column F & H, Accounting Number format to 4 decimal places for columns E and F,
 
'Number format to 10 decimal places for G and H, removes Wrap Text and auto-formats the columns to width
xlSheet.Select
With xlSheet.Cells.Select
    With xlSheet.Cells.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = False
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End With
 
xlSheet.Range("F1").EntireColumn.Delete xlShiftToLeft
xlSheet.Range("H1").EntireColumn.Delete xlShiftToLeft
 
xlSheet.Columns("E:F").NumberFormat = "_($* #,##0.0000_);_($* (#,##0.0000);_($* ""-""????_);_(@_)"
xlSheet.Columns("G:H").NumberFormat = "0.0000000000"
 
xlSheet.Range("D1").EntireColumn.Delete xlShiftToLeft
 
With xlSheet.Cells.Select
    With xlSheet.Cells
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
End With
 
xlSheet.Cells.EntireColumn.AutoFit
xlSheet.Range("A1").Select
 
'Rename Sheet 1 to "MM-DD-YYYY"
 
xlSheet.Name = "mnth + "-" + dy + "-" + yr"
 
Set xlBook = Nothing
Set xlSheet = Nothing
xl.ActiveWorkbook.Save
Set xl = Nothing
End Function
 

Users who are viewing this thread

Back
Top Bottom