I'm writing a function in Outlook VBA that involves reading content from an excel workbook.
The part I'm struggling with is finding the last row in a column (column A in this example). While the 1st line in the highlighted block correctly displays the content of A1 cell in given worksheet, the second line gives a Error "424" - object required.
Any suggestions into the problem would be greatly appreciated.
Public Function openExcel()
Dim xlApp As Object
Dim sourceWorkBook
Dim sourceWorkSheet
Dim cellVal As String
Dim lastRow As Long
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = True
End With
Set sourceWorkBook = xlApp.Workbooks.Open("C:\SAMPLEPATH\Template.xlsx")
Set sourceWorkSheet = sourceWorkBook.Worksheets("Sheet1")
sourceWorkBook.Activate
With Activesheet
cellVal = sourceWorkSheet.Cells(1, 1)
lastRow = sourceWorkSheet.Cells(.Rows.Count, "A").End(xlUp).Row
End With
sourceWorkBook.Save
sourceWorkBook.Close
xlApp.Quit
End Function
If you want to have the ability to use Excel constants within your code, you will need to either
a) Include a reference to a Microsoft Excel Object Library, or
b) Create your own constant, e.g.
End(-4162)
or
Const xlUp As Long = -4162
...
... End(xlUp)
Related
I had received help yesterday on this code, but I'm completely new to VBA so I'm having difficulties. To explain my code:
I am trying to copy a range of cells from one workbook to the same range of cells in another workbook, but the names of the worksheets have to be the same. So the code is supposed to test if the worksheets exist, then it'll find the corresponding worksheets in the two workbooks. If the names are the same, it'll take on the value, but if not, it'll keep going through all the sheets in workbook1 to find the right sheet. The code runs through, but it's not copying the cells.
I assume the issue could stem from the sheetexists line within the first loop. I was told I need to make sure that I check to see if the sheets exist before running the loops, but I'm unsure of how to do that.
Thank you!
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
SheetExists = Not sht Is Nothing
End Function
Sub foo()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim shtName1 As String
Dim shtName2 As String
Dim i As Integer
Dim p As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
i = 2
p = 2
shtName2 = wkb2.Sheets(i).Name
shtName1 = wkb1.Sheets(p).Name
For i = 2 To wkb2.Worksheets.Count
If (SheetExists(shtName2) = True) And (SheetExists(shtName1) = True) Then
For p = 2 To wkb1.Worksheets.Count
If shtName2 = shtName1 Then
wkb2.Sheets(shtName2).Range("D2:G2").Value = wkb1.Sheets(shtName1).Range("D2:G2").Value
End If
Next p
End If
Next i
End Sub
You set shtName2 = wkb2.Sheets(i).Name but then never change it again. So it is always looking at one sheet only.
Your foo subroutine should be changed to:
Sub foo()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim i As Integer
Set wbk1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wbk2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
For i = 2 To wbk2.Worksheets.Count
If SheetExists(wbk2.Worksheets(i).Name, wbk1) Then
wbk2.Worksheets(i).Range("D2:G2").Value = wbk1.Worksheets(wbk2.Worksheets(i).Name).Range("D2:G2").Value
End If
Next i
End Sub
It is also a good idea to include Option Explicit as the first line of your code module. I had typos in my answer because I had copy/pasted your original code, but you had defined variables wbk1 and wbk2 and then used wkb1 and wkb2 instead. As wkb1 and wkb2 weren't explicitly declared, they were implicitly created as Variant, which then led to problems in code which expected Workbook.
Option Explicit instructs the compiler to force you to explicitly declare all variables, thus picking up such typos.
I have a workbook with a master sheet for school report cards. I have a macro applied to a button for exporting information from the master sheet to separate, newly-generated sheets in the same workbook. A1:C71 is the template and goes to every new sheet, and the following columns of info, from D1:71 to Q1:71, each appear in separate sheets (always in D1:71).
Here's the screenshot (http://imgur.com/a/ZDOVb), and here's the code:
`Option Explicit
Sub parse_data()
Dim studsSht As Worksheet
Dim cell As Range
Dim stud As Variant
Set studsSht = Worksheets("Input")
With CreateObject("Scripting.Dictionary")
For Each cell In studsSht.Range("D7:Q7").SpecialCells(xlCellTypeConstants, xlTextValues)
.Item(cell.Value) = .Item(cell.Value) & cell.EntireColumn.Address(False, False) & ","
Next
For Each stud In .keys
Intersect(studsSht.UsedRange, studsSht.Range(Left(.Item(stud), Len(.Item(stud)) - 1))).Copy Destination:=GetSheet(CStr(stud)).Range("D1")
Next
End With
studsSht.Activate
End Sub
Function GetSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
Sheets("Input").Range("A1:C71").Copy
GetSheet.Range("A1:D71").PasteSpecial xlAll
GetSheet.Range("A1:B71").EntireColumn.ColumnWidth = 17.57
GetSheet.Range("C1:C71").EntireColumn.ColumnWidth = 54.14
GetSheet.Range("D1:D71").EntireColumn.ColumnWidth = 22
End If
End Function`
I would now like to create a separate button to split the sheets into separate workbooks so that the master sheet can be kept for record keeping and the individual workbooks can be shared with parents online (without divulging the info of any kid to parents other than their own). I would like the workbooks to be saved with the existing name of the sheet, and wonder if there's a way to have the new workbooks automatically saved in the same folder as the original workbook without having to input a path name? (It does not share the same filename as any of the sheets).
I tried finding other code and modifying it, but I just get single blank workbooks and I need as many as have been generated (preferably full of data!), which varies depending on the class size. Here's the pathetic attempt:
`Sub split_Reports()
Dim splitPath As String
Dim w As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\"
Set w = Workbooks.Add
For i = 1 To lastr
wbkName = ws
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = ws
w.SaveAs splitPath
w.Close
Set w = Workbooks.Add
Next i
End Sub`
I have learned so much, and yet I know so little.
Maybe this will start you off, just some simple code to save each sheet as a new workbook. You would probably need some check that the sheet name is a valid file name.
Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=ws.Name & ".xlsx"
Next ws
End Sub
I'm trying to get data from an excel sheet to a word document. I try using the 'Find' function however I keep getting the same error "Type mismatch" on this line:
Set FoundRange = .Cells.Find(260707)
Here is the subroutine I am running.
Sub GetID()
Dim oXL As Object
Dim oWB As Object
Dim oSheet As Object
Dim WorkbookToWorkOn As String
Dim FoundRange As Range
Dim dummyvar As String
'Start a new instance of Excel
Set oXL = CreateObject("Excel.Application")
'Line to make Excel Visible or not
oXL.Visible = False
'Open the workbook
'Set the file path to access the 'Certified Personnel' table
WorkbookToWorkOn = "\\DataSource\CertifiedPersonnel.xlsx"
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set oSheet = oXL.ActiveWorkbook.Sheets("tblCertifiedPersonnel")
'End of Excel Automation. Everything from this point on can reference Excel.
With oSheet
dummyvar = .Cells(1, 2).Text
.Cells(1, 2).Select
'Set the range of the cell containing the ID number
'If the ID was found
Set FoundRange = .Cells.Find(260707)
If Not FoundRange Is Nothing Then
'Set the NTlogin equal to the value of column 1, and row corresponding to the FoundRange row
NTlogin = .Cells(FoundRange.Rows, 1).Text
Role = .Cells(FoundRange.Rows, 4).Text
End If
End With
'End Excel reference
oXL.ActiveWorkbook.Close SaveChanges:=False
oXL.Application.Quit
Set oXL = Nothing
Set oWB = Nothing
Set oSheet = Nothing
End Sub
I know it is accessing the correct workbook, because the dummy variable (dummyvar) is returning the value I expect. I have tried several things related to the 'Find' function, however I have not been able to get it to work. Any ideas? Much appreciated.
You are using late binding and have FoundRange declared as a Range. Since this is in a Word document, you're implicitly declaring it as a Word.Range here:
Dim FoundRange As Range
.Find is returning an Excel.Range. Change it to:
Dim FoundRange As Object
With the assumption that the ID values are stored as text in the worksheet, either with a cell type of Text or with an apostrophe/single-quote in front of the number, you may need to format the ID as string. With the further assumption that eventually you may want to pass the ID via parameter to the procedure, give this a try:
Set FoundRange = .Cells.Find(CStr(260707))
That will also allow you to replace the constant number with a variable if desired.
I was able to copy the rows to another workbook by using predefined ranges. However, I wanted to make sure that it only needs to copy those with values. I've been formulating this code but it returns an error -1004
Private Sub test()
Dim WBa As Workbook, MyPathA As String
Dim FinalRow As Long
Dim getDBsht As Worksheet
MyPathA = "sharepoint.com/Financial Tracker v8.xlsx"
ThisWorkbook.Sheets("ConTracker_DB").UsedRange.ClearContents
' Attempt to open a sharepoint file
Set WBa = Workbooks.Open(MyPathA)
'Set WBb = Workbooks.Open(MyPathB)
Set getDBsht = WBa.Sheets("ConTracker_DB")
getDBsht.UsedRange.Copy
'error starts here
ThisWorkbook.Sheets("ConTracker_DB").UsedRange.Paste
Application.CutCopyMode = False
WBa.Close
Set WBa = Nothing
End Sub
UPDATED CODE: UsedRange fixed my copy rows with value only, but pasting error still persists
You could iterate the individual cells and copy only those which have a value:
Dim sourceCell as Range
Dim targetCell as Range
Set targetCell = ThisWorkbook.Sheets("ConTracker_DB").Range("A1").
For each sourceCell in Range("theNamedRangeYouWantToCopyFrom")
'I'm not sure if you need a dynamic range to copy from, but if you don't...
'...it's much easier to use a "named range" for that.
If sourceCell.Value <> "" Then
targetCell.Value = sourceCell.Value
Set targetCell = targetCell.Offset(1,0)
End If
Next sourceCell
Try defining the final column you need copied and then defining the start and end cells in the range:
FinalCol = 23 '(or whatever you need)
getDBsht.Range(getDBsht.Cells(1, 1), getDBsht.Cells(FinalRow, FinalCol)).Copy
Also note that above I'm specifying which worksheet the cells in the range come from. This can help if you have multiple workbooks/worksheets open at once.
Defining the destination before you start copying is a good idea, too.
CopyTo = ThisWorkbook.Sheets("ConTracker_DB").Range("A1")
Answering my question :))
Basically if you're using usedRange.Copy
you should be pasting with
Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Please find below for the complete code if you're using this:
Private Sub test()
Dim WBa As Workbook, MyPathA As String
Dim FinalRow As Long
Dim getDBsht As Worksheet
MyPathA = "sharepoint.com/Financial Tracker v8.xlsx"
ThisWorkbook.Sheets("ConTracker_DB").UsedRange.ClearContents
' Attempt to open a sharepoint file
Set WBa = Workbooks.Open(MyPathA)
'Set WBb = Workbooks.Open(MyPathB)
Set getDBsht = WBa.Sheets("ConTracker_DB")
getDBsht.UsedRange.Copy
ThisWorkbook.Sheets("ConTracker_DB").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
WBa.Close
Set WBa = Nothing
End Sub
I want to import data from multiple workbooks, all from the same sheet index (3).
I'm new to vba, and I figured out how to open multiple files up, and also to copy data from one sheet to another sheet in a different workbook for a single file, but I can't seem to figure out how to do that for multiple files.
I highlighted where the error is, it tells me "object doesn't support this property or method"
Could you please help?
Thanks
Sub dataimport()
' Set Vars
Dim ArbinBook As Workbook, DataBook As Workbook
Dim i As Integer, j As Integer
Dim Caption As String
Dim ArbinFile As Variant, DataFile As Variant
' make weak assumption that active workbook is the target
Set DataBook = Application.ActiveWorkbook
' get Arbin workbook
Caption = "Please select an input file"
' To set open destination:
' ChDrive ("E")
' ChDir ("E:\Chapters\chap14")
' With Application
'Set "arbinfile" as variant, the "true" at end makes it into an array
ArbinFile = Application.GetOpenFilename(, , Caption, , True)
'Exit when canceled
If Not IsArray(ArbinFile) Then
MsgBox "No file was selected."
Exit Sub
End If
Dim targetSheet As Worksheet
Set targetSheet = DataBook.Sheets(1)
'Open for every integer i selected in the array "arbinfile"
For i = LBound(ArbinFile) To UBound(ArbinFile)
Set ArbinBook = Workbooks.Open(ArbinFile(i))
targetSheet.Range("A2", "G150").Value = ArbinBook.Sheets(3).Range("A2", "G150").Value
**ERROR at the line above**
Workbooks(DataSheet).Activate 'Reactivate the data book
Worksheets(1).Activate 'Reactivate the data sheet
ActiveWorkbook.Sheets(1).Copy _
after:=ActiveWorkbook.Sheets(1)
Workbooks(ArbinFile(1)).Activate 'Reactivate the arbin book(i)
ArbinBook.Close
Next i
Beep
End Sub
My instinct tells me that ArbinBook.Sheets(3) is a Chart-sheet, not a WorkSheet (or, at least, it is something other than a WorkSheet). It might be hidden as well, but it will still be indexed as (3).
If so, change Sheets(3) to Worksheets(3).
Added: BTW If true, this also demonstrates why using index-numbers is unreliable. If at all possible, refer to a worksheet by its name. (I appreciate that this may not always be possible.)
Added (from comments) There is nothing named DataSheet in your code. Add Option Explicit to the top of your module to indicate all such errors.
Try changing the line Set ArbinBook = Workbooks.Open(ArbinFile(i))
to Set ArbinBook = Workbooks(arbinfile(i))
I could be wrong, but I think it's trying to set your workbook object to become the action of opening another workbook, instead of labeling it as the workboook.
Sub Multiple()
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim exlApp As Excel.Application
Dim exlWb1 As Excel.Workbook
Dim exlWb2 As Excel.Workbook
Dim exlWb3 As Excel.Workbook
Dim exlWs1 As Excel.Worksheet
Dim exlWs2 As Excel.Worksheet
Dim exlWs3 As Excel.Worksheet
Set exlApp = CreateObject("Excel.Application")
Set exlWb1 = exlApp.Workbooks.Open("C:\yourpath1\file1.xls")
Set exlWb2 = exlApp.Workbooks.Open("C:\yourpath2\file2.xls")
Set exlWb3 = exlApp.Workbooks.Open("C:\yourpath3\file3.xls")
Set exlWs1 = exlWb.Sheets("Sheet1")
Set exlWs2 = exlWb.Sheets("Sheet1")
Set exlWs3 = exlWb.Sheets("Sheet1")
exlWb1.Activate
exlWb2.Activate
exlWb3.Activate
'code
exlWb.Close savechanges:=True
exlWb.Close savechanges:=True
exlWb.Close savechanges:=True
Set exlWs1 = Nothing
Set exlWs2 = Nothing
Set exlWs3 = Nothing
Set exlWb1 = Nothing
Set exlWb2 = Nothing
Set exlWb3 = Nothing
exlApp.Quit
Set exlApp = Nothing
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub