I've got a manual for a machine that i need to replace a large amount of part numbers with updated ones (17624 numbers). Ive got an excel doc that ive combiled with row A with old numbers and row B with the new numbers. The manual is in word (2016). Ive tried some code that i found but im unable to get it to work. Ive created a smaller excel doc with only a small list of numbers for testing reasons.
Sub findandreplace()
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open("C:\Users\lforget\Downloads\process_batch_folder_addin\list.xlsx")
Set xlWS = xlWB.Worksheets("Sheet1") 'Replace String with your Worksheet Name
lastRow = 1
For i = 1 To ThisDocument.Words.Count - 1 Step 1
For j = 1 To lastRow Step 1
ThisDocument.Words(i) = Replace(ThisDocument.Words(i), xlWS.Cells(j, 1).Value, xlWS.Cells(j, 2).Value)
Next j
Next i
Set xlWS = Nothing
xlWB.Close True
Set xlWB = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
Runtime error 6
ived tried reducing the amount of lines in the excel doc but that hasnt made any difference
Related
I'm tying to write a Macro to automatically find and replace words in a MS-word doc (800+ words) using an Excel database. Yet when I tell it to open the excel sheet I get Run-time error '1004': Excel cannot access 'Documents' (the folder where my spreadsheet is). Here's the macro I'm using (which I found here):
Function findAndReplace()
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim i As Integer, j As Integer
Dim lastRow As Integer
'Set Objects
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open("C:\Users\...\Documents")
'Replace String with path to Excel File
Set xlWS = xlWB.Worksheets("Word list for Macro")
'Replace String with your Worksheet Name
'get last row of excel file
lastRow = xlWS.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'loop through all words in Word Document
For i = 1 To ThisDocument.Words.Count - 1 Step 1
'Loop through cells in Excel File
For j = 1 To lastRow Step 1
'Replace Word value in Column B of Excel File
ThisDocument.Words(i) = Replace(ThisDocument.Words(i), xlWS.Cells(j, 1).Value, xlWS.Cells(j, 2).Value)
Next j
Next i
'Close Excel and Cleanup
Set xlWS = Nothing
xlWB.Close True
Set xlWB = NothingxlApp.Quit
Set xlApp = Nothing
End Function
Run-time error '1004': Excel cannot access 'Documents' (the folder where my spreadsheet is)
It seems the following line of code gives the error message:
Set xlWB = xlApp.Workbooks.Open("C:\Users\...\Documents")
Make sure the specified folder exists on the disk. The user name can be different on each machine, so you may get such errors if you move your code to another machine.
So, I'd suggest copying the path and opening the folder manually.
I am new to VBA and macros.
I got the repeated task of copy data from Excel and paste it in a particular location in the word document.
For example, my excel sheet has the data like this:
Col1
Col2
ID_1
I'm_One
ID_2
I'm_Two
ID_3
I'm_Three
Now i'm looking for a Word macro
Get text in Word table with cell position 3
Find the same text in Excel Col1
Get the value of Col2 from Excel
Paste the value of Col2 in word table with cell position 10
Repeat the same process for another table in Word document
[Update]
I have tried with multiple code snippets by google search but unable to construct the working macro.
Sub pull_from_Excel2()
'ref: https://www.macworld.com/article/211753/excelwordvisualbasic.html
Dim Month As String
ID_Range = "A2:A6" 'Select this as range like "A2:A16"
Offset_to_fetch = 1 'Select this to fetch comments etc. value starts with
Set xlSheet = GetObject("D:\Excel.xlsx")
'Snippets:
'Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range("A3:A5").Value)
'8204
Dim Cell As Range, rng As Range
Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range(ID_Range).Value2)
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
For Each Cell In rng
Debug.Print Cell.Text
Next Cell
End Sub
I used this url to construct my skeleton code: https://www.macworld.com/article/211753/excelwordvisualbasic.html
When i try to get the values from the range of cells in excel, i got the following error for the code.
Set rng = xlSheet.Worksheets(1).Range(ID_Range).Value2
The above line gives "Object required" error when running.
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
The above line gives "Type Mismatch" error when running.
Notes: For this error, I tried to use for each loop as this is array but the error is showing before executing the for loop.
Kindly assist.
I recommend to use Option Explicit and declare all your varibales properly. This way it is less likely that you end up with unseen errors.
To activate it for all new codes that you add in the future, you can activate it directly in Excel and Word. This is a good practice and will protect you from doing it wrong by notifying you of not declared variables:
In the VBA editor go to Tools › Options › Require Variable Declaration.
This will add Option Explicit to new modules only. In existing modules Option Explicit needs to be added manually as first line.
Further I highly recommend to name your variables according what they contain because otherwise it gets very confusing. You named your variable xlSheet but you load a workbook into it and not a worksheet.
The next issue is that your code is in Word and if you declare rng As Range then this is of type Word.Range and not Excel.Range and those are diffetent types so that is why you get a "Type Mismatch" error.
To solve this you either go in Word VBA to Extras › Refereces … and set a reference to the Excel library so you can declare your variable Dim xlRng As Excel.Range or if you don't set a reference you declare it as Object or Variant like in below example:
' This code is in Word!
Option Explicit
Public Sub pull_from_Excel2()
'declare constants
Const ID_Range As Sting = "A2:A6" 'Select this as range like "A2:A16"
Const Offset_to_fetch As Long = 1 'Select this to fetch comments etc. value starts with
Dim xlWorkbook As Object
Set xlWorkbook = GetObject("D:\Excel.xlsx") 'This expects the Excel to be already open! If not open you need to use CreateObject("Excel.Application")
Dim xlRng As Object
Set xlRng = xlWorkbook.Worksheets(1).Range(ID_Range)
Dim xlCell As Object
For Each xlCell In xlRng
Debug.Print xlCell.Text
Next xlCell
End Sub
Note if your workbook Set xlWorkbook = GetObject("D:\Excel.xlsx") is not open in Excel you need to use CreateObject("Excel.Application") and open it.
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim xlWorkbook As Object
Set xlWorkbook = xlApp.Workbooks.Open(FileName:="D:\Excel.xlsx") 'will open the workbook
xlApp.Visible = True 'make it false to open Excel invisible in the background
'your code here …
'in the end close workbook and Excel (espaciall if you had it invisible!)
xlWorkbook.Close SaveChanges:=False
xlApp.Quit 'close Excel
Option Explicit
Sub UpdateTables()
Const XLSX = "D:\Excel.xlsx"
Dim xlApp, wb, ws
Dim rngSearch, rngFound
Dim iLastRow As Long, n As Integer
' open spreadsheet
'Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(XLSX, 1, 1)
Set ws = wb.Sheets(1)
iLastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row 'xlUp
Set rngSearch = ws.Range("A2:A" & iLastRow)
' update tables
Dim doc As Document, tbl As Table, s As String
Set doc = ThisDocument
For Each tbl In doc.Tables
s = tbl.Cell(1, 1).Range.Text
s = Left(s, Len(s) - 2)
Set rngFound = rngSearch.Find(s, LookIn:=-4163, LookAt:=1) ' xlValues, xlWhole
If rngFound Is Nothing Then
MsgBox "'" & s & "' not found in table " & tbl.Title, vbExclamation
Else
tbl.Range.Cells(3).Range.Text = rngFound.Offset(0, 1)
n = n + 1
End If
Next
wb.Close False
xlApp.Quit
MsgBox n & " tables updated", vbInformation
End Sub
I have an issue with one of my VBA Word codes which extract every first sentences of every paragraphs which have more than 200 characters in Excel. My problem is that the code works only on one of my two computers, even though they both have the same Office version. Any idea why? Any idea on how to get the exact same result with another code? Thanks!
Sub aHeadlines()
On Error Resume Next
'Word objects
Dim p As Object
Dim s As String
Dim xl
Dim wb, ws, xlr
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.Workbooks.Add
Set ws = wb.Worksheets(1)
i = 1
For Each p In ActiveDocument.Paragraphs
If Len(p) > 200 Then
Set xlr = ws.Range("a" & i)
p.Range.Sentences(1).copy
xlr.PasteSpecial 3
i = i + 1
End If
Next
End Sub
I am trying to make program to see the excel workbook that is already open, but it doesn't. Controlling with xlApp.Visible = True line creates a new excel document instead making the open one visible. Any suggestions please?
Edit: I added the rest of the code here. Using catia, I am trying to reach the open excel worksheet and make modifications on it. In this case I am trying to select A1:E5 cells one by one and clear their contents
Sub CATMain()
Dim xlApp As Excel.Application
'On Error Resume Next
Set xlApp = VBA.GetObject("", "Excel.Application")
Dim exlBook As Workbook
Set exlBook = xlApp.ActiveWorkbook
Dim exlSheet As Worksheet
Set exlSheet = xlApp.ActiveSheet
xlApp.Visible = True
Dim cell1 As Integer
Dim cell2 As Integer
Dim cell3 As Integer
Dim cell4 As Integer
Dim myRange As Range
cell1 = 1 'InputBox("Tablo Başlangıç Satırını Girin: ")
cell2 = 1 'InputBox("Tablo Başlangıç Sütununu Girin: ")
cell3 = 5 'InputBox("Tablo Bitiş Satırını Girin: ")
cell4 = 5 'InputBox("Tablo Bitiş Sütununu Girin: ")
Set myRange = exlSheet.Range(Cells(cell1, cell2), Cells(cell3, cell4))
myRange.ClearContents
End Sub
My VBA code is supposed to transfer my query in MS Access (without header)
to cell K17 on an existing excel spreadsheet named Totals.
When I run the module, under the property of the excel file, last modified time did get updated to when I run the module. But I don't see my query on the excel spreadsheet.
Any advice on my code will be highly appreciated. Thank you so much!
Sub TransToXL()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim acRng As Variant
Dim xlRow As Integer
Dim qry As QueryDef
Dim rst As Recordset
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open("C:\Users\MyName\Desktop\August 2017.xlsx")
Set xlWS = xlWB.Worksheets("Totals")
xlRow = (xlWS.Columns("K").End(xlDown).Row)
Set qry = CurrentDb.QueryDefs("DollarsSold")
Set rst = qry.OpenRecordset
Dim c As Integer
c = 11
xlRow = xlRow + 16
Do Until rst.EOF
For Each acRng In rst.Fields
xlWS.Cells(xlRow, c).Formula = acRng
c = c + 1
Next acRng
xlRow = xlRow + 1
c = 1
rst.MoveNext
If xlRow > 25 Then GoTo rq_Exit
Loop
rq_Exit:
rst.Close
Set rst = Nothing
Set xlWS = Nothing
xlWB.Close acSaveYes
Set xlWB = Nothing
xlApp.Quit
Set xlApp = Nothing
Exit Sub
End Sub
The variable c is the one that stores colum number, in which c =1 means column A, 11 will be K. In this code, I'm confused about the way I set xlRow+16. xlRow+16 , and c = 11 is not pointing out to K17. Any advise on this? Thank you!
Is there a reason why you are using a Do Until loop? If the recordset only has 1 row of data (the total) it looks like you could remove the loop and just use something like:
xlWS.Range("K17").Value = rst.Fields(0)
This would appear after the "Set rst.." line.