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.
Related
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'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
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
I've Searched Forums here and I can't seem to get this code to work.
I am Trying to Open a Workbook in Excel, and then populate a few of the Cells(Named Ranges). I can successfully open the workbook(the workbook has a bit of VBA that runs when it opens as well, formatting stuff only) but when I get down to the inputting information I get a 'Run-Time Error "438" Object Doesn't support this property or method.'
From the Previous answers on other similar questions I have done everything the way it was suggested however, I can't seem to get it to work.
Option Compare Database
Option Explicit
Public Sub MaterialInput()
Dim xlapp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim RsClient As Recordset
Dim RsJobsite As Recordset
Dim db As Database
Dim ClientSTR As String
Dim JobsiteSTR As String
Dim customer As Variant
Set db = CurrentDb
JobsiteSTR = "SELECT T1Jobsites.JobsiteNickName FROM T1Jobsites WHERE T1Jobsites.JobsiteID = 1" ' & Form_LEM.TxtJobsiteID
Set RsJobsite = db.OpenRecordset(JobsiteSTR, dbOpenSnapshot, dbSeeChanges)
ClientSTR = "SELECT T1Companies.CompanyName " & _
"FROM T1Companies INNER JOIN T1Jobsites ON T1Companies.CompanyID = T1Jobsites.CompanyId " & _
"WHERE (((T1Jobsites.JobsiteID)=1))"
'ClientSTR = "SELECT T1Companies.CompanyName FROM T1Companies INNER JOIN T1Jobsites ON T1Companies.CompanyID = T1Jobsites.CompanyID" & _
" WHERE T1JobsitesID = 1" '& Form_LEM.TxtJobsiteID
Set RsClient = db.OpenRecordset(ClientSTR, dbOpenSnapshot, dbSeeChanges)
Set xlapp = CreateObject("excel.application")
Set wb = xlapp.Workbooks.Open("C:\Users\coc33713\Desktop\VISION - EXCEL FILES\VISIONCOUNT.xlsm")
Set ws = xlapp.Worksheets("CountSheet")
xlapp.Visible = True
'Tried this second after reading another forum
'the comments Recordset will be the actual values used, but I can't get the String "TEST" to work
wb.ws.Range("Client").Value = "TEST" 'RsClient!CompanyName
'Tried this way first
xlapp.ws.Range("'SiteName'").Value = "Test" 'RsJobsite!JobsiteNickName"
xlapp.ws.Range(Date).Value = "Test" 'Form_LEM.TxtDate
xlapp.ws.Range(ProjectName).Value = "Test" 'Form_LEM.TxtPlant
xlapp.ws.Range(ScaffoldID).Value = "Test" 'Form_LEM.cboScaffnum.Value
xlapp.ws.Range(ScaffoldNumber).Value = "Test" 'Form_LEM.cboScaffnum.Column(1)
Set xlapp = Nothing
Set wb = Nothing
Set ws = Nothing
Set RsClient = Nothing
Set RsJobsite = Nothing
Set db = Nothing
End Sub
As a Sidenote this is not a form it is just spreadsheet
Thank you everyone!
Use
ws.Range("Client").Value = "Test"
Or
Dim sName as String
sName = "Client"
ws.Range(sName).Value = "Test"
Reason being is that you have the ws object set already, so there is no need to assign parentage to it again. In fact, trying to do so will break syntax rules.
FWIW (not your issue - that is solved by Scott's answer): Note that
Set ws = xlapp.Worksheets("CountSheet")
should be
Set ws = wb.Worksheets("CountSheet").
Using xlapp.Worksheets("CountSheet")
is effectively xlApp.ActiveWorkbook.Worksheets("CountSheet") which might be (and probably is) xlApp.Workbooks("VISION - EXCEL FILES\VISIONCOUNT.xlsm").Worksheets("CountSheet") but it is better to do it correctly rather than leave it to chance.
Thank you guys!
This should do what you want.
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb")
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable)
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("NamedRange1").Value
.Fields("FieldName2") = Range("NamedRange2").Value
.Fields("FieldNameN") = Range("NamedRangeN").Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
i want to export mysql table data with column heading to excel sheet. am using vb.net. but am not able to get table column heading in excel sheet. am getting only mysql table data.
my code
-------
Dim i, j As Integer
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To ds.Tables(0).Rows.Count - 1
For j = 0 To ds.Tables(0).Columns.Count - 1
xlWorkSheet.Cells(i + 1, j + 1) = _
ds.Tables(0).Rows(i).Item(j)
Next
Next
xlWorkSheet.SaveAs("D:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
I don't know Vb.net, but I had a similar issue and had to use the syntax:
IGNORE 1 LINES in the statement.
http://dev.mysql.com/doc/refman/5.1/en/load-data.html (this is for importing, but the IGNORE 1 LINES syntax is described here...)