Powerpoint VBA: How to get last used column in a row from an Excel sheet - vba

Q: How do I get the last used column in a specific row from an Excel sheet.
While this is a simple task using Excel VBA its more difficult using Powerpoint VBA.
Here is an example of my Excel sheet
Steps to reproduce
create & save a new Excel sheet like my example above
open a new PowerPoint presentation & hit ALT+F11 for the VBA editor
insert the code below and customize the path to your test Excel file in line 3
execute the code line per line using F8
Sub findlastcolumn()
Set objExcel = CreateObject("Excel.application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\<USERNAME>\Desktop\data.xls")
objExcel.Visible = True
'works in Powerpoint VBA but delivers the wrong column
lastcol = objWorkbook.Sheets(1).UsedRange.Columns.Count
'produces an error in Powerpoint VBA
'but works in Excel VBA, correct column in Excel VBA
lastcol = objWorkbook.Sheets(1).Cells(1, 254).End(Direction:=xlToLeft).Column
'produces an error in Powerpoint VBA
'but works in Excel VBA, and wrong column in Excel VBA too
lastcol = objWorkbook.Sheets(1).Cells.SpecialCells(xlLastCell).Column
'wrong column. Powerpoint VBA' find method differs from Excel' find method
'searchdirection isn't available in Powerpoint VBA
lastcol = objWorkbook.Sheets(1).Rows(1).Find(what:="*", _
after:=objWorkbook.Sheets(1).Cells(1, 1), searchdirection:=xlPrevious).Column
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
End Sub
Desired result: I want to get lastcol = 3
The comments in my code show you what I have tried so far and what error they produce.
I'm thankful for any advice.
There is no PowerPoint 2003 tag? O.o

The Excel specific code you posted should actually work and give you the same result as if you execute it in Excel.
The reason you do get error message is most likely that you did not in include the Excel reference in your Powerpoint VBA! You do use Late Binding, so it's generally not necessary to reference this library. However, the VBA compiler does not know the internal values of the Excel constants/enums xlToLeft, xlLastCell and xlPrevious and therefore produces the error!
Two options to solve your issue:
Include the Microsoft Excel library in your references
Instead of using the Excel specific conmstants/enums, just use their underlying numerical values. To do so, go to the Excel Visual Basic editor. In the Immediate window (Ctrl-G), type ? xlToLeft - and you'll get the result (in this example -4159). Then replace the name in your Powerpoint VBA with the number and it should work. (For better code readability, I usually leave the name of the constant in a comment in the same line, e.g.
lastcol = objWorkbook.Sheets(1).Cells.SpecialCells(11).Column 'xlLastCell = 11

#nixada, You can do it from POWERPOINT vba:
You need to get to the workbook object: (assuming you have the excel data in slide #1, on chart #1:
Set cht = ActivePresentation.Slides(1).Shapes(1).Chart
Set DataWorkBook = cht.ChartData.Workbook
Then you should get your last blank column using the blank type:
LastCol = DataWorkBook.Sheets(1).Cells.SpecialCells(4).Column -1 'xlCellTypeBlanks = 4
That should give you the desired answer "3"
Note: for the list of types you can refer to XlCellType enumeration (Excel)
EDIT: Using xlCellTypeLastCell ( = 11: The last cell in the used range) will not necessary give you the desired answer as if a cell was used but its content now deleted, it will be considered as used cell in the range.

Here is what you can do. * proviso: untested code. If this doesn't work, tell me in the comments *
Dim r as Range
Dim col = 0
set r = objWorkbook.Sheets(1).Range("A1")
while(** test that r has something in it **)
col = col + 1
set r = r.offset(0, 1)
end
I don't have the setup handy to figure out what the test should be - but that ought to be easy. The point is that this doesn't use constants the Powerpoint VBA doesn't know (like xlDown).

I just want to post the corrected code if anyone stumbles over a similar issue. (Thanks to Peter Albert)
Sub findlastcolumn()
Set objExcel = CreateObject("Excel.application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\<USERNAME>\Desktop\input data.xls")
objExcel.Visible = True
icolumn = 1 'which column should be checked (in sheet 1)
'works
Set r = objWorkbook.Sheets(1).Cells(icolumn, objWorkbook.Sheets(1).Columns.Count)
Do: Set r = r.offset(0, -1)
Loop While r.Value = ""
lastcol1 = r.Column
'works
lastcol2 = objWorkbook.Sheets(1).Cells(icolumn, _
objWorkbook.Sheets(1).Columns.Count).End(Direction:=-4159).Column
'works
lastcol3 = objWorkbook.Sheets(1).Rows(icolumn).Find(what:="*", _
after:=objWorkbook.Sheets(1).Cells(1, 1), searchdirection:=2).Column
'works - but not if your columns have different last cells
lastcol4 = objWorkbook.Sheets(1).UsedRange.Columns.Count
'works - but not if your columns have different last cells
lastcol5 = objWorkbook.Sheets(1).Cells.SpecialCells(11).Column
End Sub

Related

Error 1004 renaming worksheets

I keep having troubles with "Error 1004 - Method 'Name' of object '_Worksheet'" in my VBA macro.
Basically the idea of this macro is to check the cells of a column (containing strings) and to compare them to the names of the worksheets of my workbook.
If there is a cell whose value doesn't appear among the names of the worksheets, the macro should create a new worksheet and rename it after the value inside the cell.
For j = (RowStart + 1) To 500
'allocate the value of the reference cell in cell_content
cell_content = Worksheets("Worksheet1").Cells(j, ColStart).Value
Switch = 0
'check if cell_content appears as the name of one of the worksheet
For i = 1 To Sheets.Count
If cell_content = Sheets(i).Name Then
Switch = Switch + 1
End If
Next i
'if it does not, the macro creates a new worksheets with the name of cell_content
If Switch = 0 Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = cell_content
End If
Next j
Consider that ColStart and RowStart are just the reference values for the column under consideration and the variable Switch is used to define whether or not it is required to create a new worksheet.
The problem is that the very last part of the macro keeps giving me error 1004.
Does anyone know what can be the problem?
Thank you very much
I guess your workbook is locked. A small code like this works on an empty Excel:
Public Sub TestMe()
Dim ws As Worksheet
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = "CodeThatWorks"
End Sub
What may be the other possible reason that your code does not work is that the name is like this ws.Name = "BadNamesIncludeThese:]\?*[]", thus including special characters which are not allowed for a name in the worksheet.

Copy Data from Word to Excel based on Headings and surrounding text

I am given a Word file which contains 30 cases every week. I have to get data and place them in columns in an Excel file.
The Word file looks like this: https://imgur.com/a/0msJs
I am thinking of two approaches:
Add tags on the titles and citations since they don't have headings or anything else that could distinguish them: /title A vs. B and /cite 123 A.B.C. 234 (yellow and purple highlight in the pic).
Take the paragraph after the /title and /cite.
Look for the whole paragraph after "OVERVIEW:" since this data is distinguished by this string.
Summary:
I want to copy all case titles (yellow) into a column in an existing Excel sheet, copy all the citations (purple) into another column, copy all overviews (red) into another column, etc.
Sample Excel and Word file used: file
Note: case names and arrangement in the file attached above will not match since I have already edited and sorted the Excel file. I just need the macro to copy the data and then I would sort it later.
I would say that you need to get everything into Excel, as such.
Sub Sentence_Click()
Dim num As Variant
'Microsoft Word object
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Word document object
Dim WordNam As String
WordNam = "C:\Users\Excel\Desktop\September Week 1 2017.docx"
'Open word document
objWord.Documents.Open WordNam
j = 1
n = objWord.Documents(WordNam).Paragraphs.Count
For Each num In Array(7, 13, 23)
For i = 1 To n
If i = num Then
ThisWorkbook.Worksheets(1).Cells(j, 1) = objWord.Documents(WordNam).Paragraphs(i)
Debug.Print num
j = j + 1
End If
Next i
Next num
'Close objects
objWord.Documents.Close
objWord.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
Then parse out the data in Excel, any way you choose.
As you can see, I am importing based on paragraph number, and not based on color. I think you added those colors; I don't think the document comes to you like that.
I'm not going to write the code for you, but to get you started this code, if pasted into a vb module in Word, will copy any selected text in the current word document into a blank spreadsheet in excel.
Sub copytext2XL()
Dim r As Range 'nb this is a Word range, not an Excel range
Dim xl
Dim wb, ws, xlr
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.workbooks.Add
Set ws = wb.worksheets(1)
Set xlr = ws.Range("a1")
Set r = Selection.Range
r.Copy
xlr.PasteSpecial 3
End Sub

Inserting column in Excel 2013 Add In fails with Error 438

I would appreciate help solving this vexing problem with inserting a column into a worksheet with VBA. The worksheet is generated from a database. I need to insert a column into the worksheet for data that is not part of the database. The project takes the data from the worksheet and writes it to a series of Word forms. The code works fine when run from a module in the macro enabled worksheet. When I use the code in an Add-In (.xlam) it doesn't insert the column and an Error 438 is captured by Err.Number. When I put the module in a separate workbook and run it, the column is inserted but the error is still captured. I've tried a lot of the suggestions for debugging and fixing my code to run properly in an add-in. The add in is signed with a valid certificate which should allow it to run on our network.
I started using the .EntireColumn.Insert but switched to Selection.Insert to see it that would work. Both versions fail to insert the column. I also changed the code to create a specific reference to the target worksheet instead of relying on ActiveWorkbook or Activesheet.
Edit: The worksheets are not protected.
I was using #Rory method for Excel VBA Add In Control.
I tried #ErikEidt's answer to Standalone code for Excel to use a button on the Excel Quick Access Toolbar to run the Add-In.
I still get the error message but the code exectues and the column is inserted successfully.
Here is the relevant extract of my code.
Option Explicit
Sub FormfromExcell()
'Note:Requires Reference to Microsoft Word and Excel(15.0 for 2013)Object Library set in Tools>References
'DECLARE AND SET VARIABLES
' Excel Objects
Dim WBA As Workbook 'The Active workbook
Dim WBAname As String
Dim wksht As Worksheet 'Excel Worksheet
Dim shtName As String
Dim myLastRow As Long
Dim myLastCol As Long
' Initialize the Excel Objects
Set WBA = ActiveWorkbook 'The workbook that calls the Add-In
WBAname = ActiveWorkbook.Name
shtName = WBA.Worksheets("Dynamic Risk Report").Name
Set wksht = WBA.Worksheets("Dynamic Risk Report")
'Set wksht = Workbooks("WBAname").Worksheets("shtName")
Application.StatusBar = "Checking for Status and Action Columns"
' Check for presence of non-database columns (Action and Status) and insert them if not there.
If wksht.Cells(1, "D") = "Action" Then GoTo Checkforstatus
'wksht.Range("D1").EntireColumn.Insert
wksht.Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
If Err.Number <> 0 Then MsgBox "Error" & Err.Number
wksht.Cells(1, "D").Value = "Action"
Checkforstatus:
'Rest of code
If you can eliminate the Select and just do a straight insert, will that work?
Also you try defining your own constants, just in case Add-In doesn't have access - even though that doesn't make sense to me, seeing as you're runnign this from Excel
Const xlToRight = -4161
Const xlFormatFromLeftOrAbove = 0
Dim rge As Range
Replace this:
wksht.Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
With this
Set rge = wksht.Columns("D:D")
rge.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Moving Worksheets to Newly Created & Version Changed Workbook VBA

I am continuing working with data pulled from a mainframe. The data is largely alphanumeric, and is a continuation of building functionality onto past efforts. The loop in which the sheets are moved was created on the basis of the function discussed in this SO article.
I have consulted this SO article and independently tested the general form of such functionality, but such code is failing in this specific case, perhaps due to version issues or the way I am referencing the new workbook.
I have written a subroutine that shifts worksheets from one workbook to another. It is used in conjunction with a public variable tied to a checkbox, and is intended to provide the user with an easy way to port the form data. The public variable is used in a conditional to call the subroutine if the checkmark is in a checked state.
The code is as follows:
Public Sub MoveSheets()
' This macro moves all sheets but those noted within the If statements,(1)
' (1) which are further nested within the For Each loop.
'See http://msdn.microsoft.com/en-us/library/office/ff198017.aspx for save file format types.
'The file format of this excel macro sheet is 52: xlOpenXMLWorkbookMacroEnabled
'The default save type for the use-case is excel 2003 is compatibility mode.
'The macro is to set the current save type to one compatible with 52.
'In this case, 51: xlOpenXMLWorkbook was selected as the selected type.
'Define Excel Format storage variables.
Dim FileFormatSet As Excel.XlFileFormat
Dim OriginalFileFormatSet As Excel.XlFileFormat
Dim TempFileFormatSet As Excel.XlFileFormat
'Define worksheet/workbook variables.
Dim IndividualWorkSheet As Worksheet
Dim NewWorkBook1 As Workbook
'Set variable to store current time.
Dim CurrentTime As Date
'The original file format.
OriginalFileFormatSet = Application.DefaultSaveFormat
'The file format to be used at the end of the procedure after all is said and done.
FileFormatSet = OriginalFileFormatSet
'The currently desired file format.
TempFileFormatSet = xlOpenXMLWorkbook
'The currently desired file format set as the set default.
Application.DefaultSaveFormat = TempFileFormatSet
'Disable application alerts. Comment the line below to display alerts (2)
'(2) in order to help check for errors.
Application.DisplayAlerts = False
'Save new workbook "NewWorkBook" as default file format.
Workbooks.Add.SaveAs Filename:="NewWorkBook", FileFormat:=Application.DefaultSaveFormat
'Set variable to new workbook "NewWorkBook", which is in .xlsx format.
Set NewWorkBook1 = Workbooks("NewWorkBook.xlsx")
'Activate Macro Window.
Windows("ShifterMacro.xlsm").Activate
'For each worksheet, shift it to the workbook "NewWorkBook" if (3)
'(3) it fails outside the criteria set listed below.
For Each IndividualWorkSheet In ThisWorkbook.Worksheets
If IndividualWorkSheet.Name <> "Sheet1" And IndividualWorkSheet.Name <> "Criteria" And _
IndividualWorkSheet.Name <> "TemplateSheet" And IndividualWorkSheet.Name <> "TemplateSheet2" And _
IndividualWorkSheet.Name <> "Instructions" And IndividualWorkSheet.Name <> "Macro1" And _
IndividualWorkSheet.Name <> "DataSheet" Then
'Select each worksheet.
IndividualWorkSheet.Select
'Shift the worksheetover to the new workbook.
'****NOTE: THIS CODE CURRENTLY RESULTS IN A '1004' RUN-TIME ERROR.****
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
End If
Next
'An ugly set of If Then statements to clean the new workbook (4)
'(4) of its previous sheets, assuming entries are to be made.
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet1").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet2").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet3").Delete
End If
'********** CODE CHECKED BUT UNTESTED WITHIN THESE BOUNDARIES **********
'Activate the Window for the new workbook if it is inactive.
Windows("NewWorkBook.xlsx").Activate
'If the number of sheets are greater than 1... (5)
If Sheets.Count > 1 Then
'(6) The time value is parsed to remove unusual characters, following (5)
'(6) the logic of this SO article: https://stackoverflow.com/questions/11364007/save-as-failed-excel-vba.
'Formatted current time as per http://www.mrexcel.com/forum/excel-questions/273280-visual-basic-applications-format-now-yyyymmddhhnnss.html
CurrentTime = Format(Now(), "yyyy-mm-dd-hh-nn-ss")
'(5) Then go ahead and save the file with the current date/time information.
NewWorkBook1.SaveAs Filename:="Form_Data_" & Now, FileFormat:=Application.DefaultSaveFormat
End If
'Set SaveChanges = True, as per https://stackoverflow.com/questions/9327613/excel-vba-copy-method-of-worksheet-fails
ActiveWorkbook.Close SaveChanges:=True
'********** END CODE BOUNDARY **********
'Activate the Window for the Macro.
Windows("ShifterMacro.xlsm").Activate
'Activate a specific sheet of the Macro.
ActiveWorkbook.Sheets("Instructions").Activate
'Change Display Alerts back to normal.
Application.DisplayAlerts = True
'Reset the view for the original data sheet.
With Sheets("Sheet1")
'For when this process is repeated.
If .FilterMode Then .ShowAllData
End With
'Return the Default save format to the original file format.
Application.DefaultSaveFormat = FileFormatSet
End Sub
The code fails at line 62, and results in a '1004' Run-Time error:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
The worksheet referenced holds the correct test value of '100-AAA'. The Sheets.Count is equal to 3. The NewWorkBook1 variable holds the value NewWorkBook.xslx. The path of the generated workbook "NewWorkBook.xslx" is the same as the macro workbook. My version of excel is 2007, although the default for my users is 2003, even though they have the capacity and the installation for 2007.
Why is this run-time error with my Move occuring, and how do I correct this error in order to get my worksheets over to the newly generated workbook?
This:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
just specifies to move the sheet within the same workbook (and it will error if NewWorkBook1 has more sheets than its parent workbook)
Maybe try:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets(NewWorkBook1.Sheets.Count)

How to create instances of hidden worksheet in excel using vba?

I am creating an macro-enabled Excel as a tool for generating 'create table' sql script. The sheet is created where one needs to enter the column names, data type etc., and on a button click the script will be generated. This sheet is called 'Script Generator'. Now I need an 'Index' sheet which will have table names and a button. When I click the button I need to open 'script generator' sheets for each table name and these sheets should be renamed to the table name.
The index sheet code goes like this:
Sub Add_sheets()
On Error Resume Next
Dim count As Integer
Dim r As Range
Dim sh As Worksheet
For Each r In Range("A3:A103")
If Not r = "" Then
count = 0
For Each sh In ActiveWorkbook.Sheets
If sh.Name = r.Value Then
count = count + 1
End If
Next sh
If count = 0 Then
With ActiveWorkbook.Sheets
.Add(after:=Worksheets(Worksheets.count), Type:="C:\Macro\Script_Template.xltm").Name = r.Value
End With
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", _
SubAddress:=Sheets(r.Value).Name & "!A1"
End If
End If
Next r
End Sub
Now, the problem is I am adding the script generator saved as 'Script_Template.xltm' externally. I need only one Excel which will do this all. Means, the Index file should internally open/add the new sheets of the format 'script generator' so that it forms one complete tool. Maybe by hiding this sheet and calling its instances through macros and renaming those sheets. How to do it through VBA? Could someone help me with this?
Using True and False for setting the Visible property of a worksheet is not good practice. You should use the constants already provided - xlSheetHidden, xlSheetVeryHidden and xlSheetVisible.
xlSheetVisible will make your sheet visible and xlSheetHidden will hide your sheet. Setting it to xlSheetVeryHidden will ensure that the only way you can make the sheet visible is through VBA and not through the Excel menubar Format -> Sheet -> Unhide.
Usage:
Sheets("Script_Template").Visible = xlSheetVisible
You can create a "Script_Template" sheet and hide it and then use this code create a copy
Sheets("Script_Template").Visible = True
Sheets("Script_Template").Copy After:=Sheets(ThisWorkbook.Sheets.count)
ActiveSheet.Name = r.Value
Sheets("Script_Template").Visible = False