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.
Related
Perhaps I just haven't used the right search terms, I am still new to VBA, but I just can't find the solution to my problem:
I am trying to find a value (format 'yyyy-ww') from one worksheet in the row of another worksheet, and then select the cell (the next step would then be to then select and copy the respective column, and then paste the values).
I have the following code:
Private Sub Button5_Click()
'Define previous week and the search range
Dim prevwk As Object
Dim SrchRng As Range
Set prevwk = ActiveWorkbook.Worksheets("Values").Range("B1")
Set SrchRng = ActiveWorkbook.Worksheets("DE").Rows(1)
'If previous week is found, select the cell
With SrchRng
Dim prevwkf As Range
Set prevwkf = SrchRng.Find(What:=prevwk)
prevwkf.Select '<----- Error is here
End Sub
I keep receiving the error message:
'Run-time error '91': Object variable or With block variable not set'.
I have tried many changes but it keeps coming down to this error message.
Many thanks for your help!
before selecting a cell you have to activate the sheet, just as you would do manually:
SrchRng.parent.Activate
prevwkf.Select
BTW you don't need that With SrchRng, and you could check for actual match found
Private Sub Button5_Click()
'Define previous week and the search range
Dim prevwk As Object
Dim SrchRng As Range
Set prevwk = ActiveWorkbook.Worksheets("Values").Range("B1")
Set SrchRng = ActiveWorkbook.Worksheets("DE").Rows(1)
'If previous week is found, select the cell
Dim prevwkf As Range
Set prevwkf = SrchRng.Find(What:=prevwk)
If Not prevwkf Is Nothing Then ' check you actually found something
SrchRng.Parent.Activate
prevwkf.Select '<----- Error is here
End If
End Sub
I am trying to add a huge amount of autocorrect entries into WORD loading the data of an excel file/sheet.
This is actually not with Autocorrections purposes but in order to use shortcuts to introduce complete paragraphs to write much faster.
First I tried:
Sub autocorrectlist()
'TRYING OUT IF using variables works for a new autocorrect entry.
Dim myString1 As String
Dim myString2 As String
myString1 = "BBBB"
myString2 = "BBBB works works works"
AutoCorrect.Entries.Add Name:=myString1, Value:=myString2
This worked. when writing BBBB in Word get substitute by the other expression.
lets try to read values from the excel file.
It is a big long here the code but it consist basically in open an excel file and read the entries of an excel sheet, one column being the entries for the so called shortcut (the text that has to be substitute) and the other one the substituting text)
'lets create a huge list of modifiers
Dim i As Integer 'counter
'Read Excel File Megaclause
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
'specify the workbook to work on
WorkbookToWorkOn = "C:\Users\JF30443\Desktop\WORK\EXCEL\megaclause7.xlsm"
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
oXL.Visible = True
'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
'Process each of the spreadsheets in the workbook
Dim mySht As Worksheet
Set mySht = oWB.Worksheets("sc6")
Dim lastRow As Integer
lastRow = mySht.Cells(mySht.Rows.Count, "A").End(xlUp).Row
Dim myName As String
Dim myAuto As String
'reading the values from the sheet
For i = 1 To lastRow
myName = mySht.Cells(i, 1).Value
myAuto = mySht.Cells(i, 2).Value
If myName <> "" And myAuto <> "" Then
MsgBox ("nr:" & i & "myName:" & myName & "//myauto:" & myAuto)
'note here: actually it read correctly the two first values of the SC6 sheet
'Since the values displayed by the msgbox are correct
'the following line gives an error
Application.AutoCorrect.Entries.Add Name:=myName, Value:=myAuto
'the error being:
'AutoCorrect cannot replace text which contains a space character.
End If
Next
If ExcelWasNotRunning Then
oXL.Quit
End If
'Make sure you release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
End Sub
As stated in the code between lines the code reads the sheet because the msgbox displays correctly the two first values of the sheet called "SC3" but inmediatly after it gives error.
I copied partially this code from internet, but the one I thought would be the most difficult part (reading from word in excel) works, and then I can not add the entry.
What is even more strange is that the first part of the code above pasted (the one with "BBBB") works, which is basically the same approach as in the loop.
I searched for info in the net but I did not find anything relevant relating to taht error.
Help is welcome
Thanks.
The problem was an initial space in the names of the sheet
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)
I am copying a range from one worksheet to the next using the following code:
Private Sub btn_Milestones_Click()
Dim projectref As String
Dim savelocation As String
Dim projectSearchRange As Range
Dim LastRow As Integer
Dim NewWorkbook As Workbook
Dim copy_range As Range
'set search value (porject key - unique)
projectref = cmb_Project.Value
Application.ScreenUpdating = False
Workbooks("Project tracker spreadsheet VBA").Activate
'find the project reference in the tracking spreadsheet
With Sheets("Project Tracking")
Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole)
If Not projectSearchRange Is Nothing Then '<-- verify that find was successful
LastRow = projectSearchRange.Row
'file directory to save the new workbook in
savelocation = .Cells(LastRow, 5).Value
Else '<-- find was unsuccessful
MsgBox "Unable to find " & projectref
Exit Sub
End If
End With
Set copy_range = Range(Cells(LastRow, 11), Cells(LastRow, 34))
Worksheets("Milestone_Template").Range(copy_range).Copy 'application defined or object defined error occurs here
Worksheets("Project Tracking").Range("A7:X7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
As the code illustrates, I am looking for a unique reference number in the "Project Tracking" Sheet, then using the row number to define a range to copy. copying that range and pasting the values of that range into a new sheet. However, I am getting the application error on the line indicated in the code. I've triple checked to make sure the worksheet names are correct.
I have a feeling it is to do with the way I've declared the range and how it is attempting to copy the values, but I can not see where it could be throwing this error from.
Can anybody see where I would be getting this error from, and what I need to do to resolve it?
Thanks.
Sorry you got beat up, I have edited question title so your specific problem is identified. Here's an attempted answer ...
It is quite difficult to debug without the data but it looks like copy_range is already of type Range, you seem to use it on the problem line like it was a String range expression like "A1:C3". So I have rewritten, you can go straight to copy_range.Copy.
The commenters are right that full qualification helps clarify issues, so I have done some full qualification but not all.
Try this
Option Explicit
Private Sub btn_Milestones_Click()
Dim projectref As String
Dim savelocation As String
Dim projectSearchRange As Range
Dim LastRow As Integer
Dim NewWorkbook As Workbook
Dim copy_range As Range
'set search value (porject key - unique)
projectref = cmb_Project.Value
Application.ScreenUpdating = False
Workbooks("Project tracker spreadsheet VBA").Activate
Dim wbSource As Excel.Workbook
Set wbSource = Workbooks("Project tracker spreadsheet VBA")
'find the project reference in the tracking spreadsheet
With Sheets("Project Tracking")
Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole)
If Not projectSearchRange Is Nothing Then '<-- verify that find was successful
LastRow = projectSearchRange.Row
'file directory to save the new workbook in
savelocation = .Cells(LastRow, 5).Value
Else '<-- find was unsuccessful
MsgBox "Unable to find " & projectref
Exit Sub
End If
End With
Dim wsMilestoneTempate As Excel.Worksheet
Set wsMilestoneTempate = wbSource.Worksheets("Milestone_Template")
Set copy_range = wsMilestoneTempate.Range(wsMilestoneTempate.Cells(LastRow, 11), wsMilestoneTempate.Cells(LastRow, 34))
copy_range.Copy
''''Worksheets("Milestone_Template").Range(copy_range).Copy 'application defined or object defined error occurs here
Worksheets("Project Tracking").Range("A7:X7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
I would like to append data using word as front-end userform and export the data to specific csv file when submit button is clicked.
While firstly I need to know which row I should append the data. Here is the following code and I got error message for nrow = rng1.UsedRange.Rows.Count lines
'Reference - Microsoft Excel 12.0 Object library 12
'Word
Global objDoc As word.Document
Global docName As String
Global docPath As String
Global docFullName As String
'Workbook
Global objWb As Excel.Workbook
Global objWs As Excel.Worksheet
Global rng1 As Range
Global nrow As Integer
'Global objWord As word.Application
Public Sub Initial_Global()
'Word
Set objDoc = ActiveDocument
docName = objDoc.Name
docPath = objDoc.Path
docFullName = objDoc.FullName
'Excel
Set objWb = Workbooks.Open(FileName:="C:\Users\1502911\Desktop\Database1.csv")
Set objWs = objWb.Worksheets("Database1")
Set rng1 = objWs.Range("A1")
nrow = rng1.UsedRange.Rows.Count
MsgBox nrow
End Sub
nrow = rng1.UsedRange.Rows.Count
this means:
Worksheets("Database1").Range("A1").UsedRange.Rows.Count 'wrong
of course it will return error, because you asking the used range of the range "A1"
must be like this:
Worksheets("Database1").UsedRange.Rows.Count
so in your code, if you required to count only rows in used range of the column "A" must be the next:
nrow = objWs.UsedRange.Columns(1).Rows.Count
but be carefull with this method of the getting the last row in sheet, the problem will apear when the used range will not start from the first row, e.g. if the first row will be empty then you will recieve count less then expected. in this case use this method:
nrow = objWs.Cells(Rows.Count, 1).End(xlUp).Row
also can be the problem, when e.g. count of the used cells in column "A" less by the some reason than count of the used cells in Columns "B" or "D " etc. but you need to get the last non-used row, in this case you need this method:
Dim ocell As Range
For Each ocell In objWs.UsedRange
nrow = ocell.Row
Next
MsgBox nrow