How can I loop through Access Field Names by index? - excel

I am trying to build an Access db of inspection data for mass manufactured plastic parts from a bunch of Excel sheets, which come from different sources.
I am doing this with two Access files: one as the front end/UI (Forms and Macros), and one as the back end (Tables containing the desired data).
My process:
Use front end Access Form to open the msoFileDialogFilePicker and select an Excel sheet of data to get read into my back end Access Table. The Table where the data is stored in the back end file depends on radio buttons selections in the front end file Form.
Macro reads data from Excel sheet, transposes data, and stores it in a new dumpSheet at the end of the original data file. Each row in this dumpSheet is effectively its own record in the corresponding back end Access table. Data gets read into back end Access Tables using DAO.Database and DAO.Recordset.
Repeat with new inspection data as it comes in every two weeks.
The inspection data comes from different sources, but it can be for the same plastic part. This combination of company + part dictates which fields are of interest to be read into the recordset. For example, all of these combinations would have different fields (each combination has its own table), but there is new inspection data for each combination every two weeks (hence the need for a db):
Company X + Part A
Company X + Part B
Company Y + Part A
Company Y + Part B
Here is a general look at how I'm setting this up in the Access front end Form Macro (where the fields listed in the Do While Loop are for one specific Company + Part combination:
Set excelTemp = New Excel.Application
excelTemp.Visible = True
excelTemp.DisplayAlerts = True
Set trExcelWB = excelTemp.Workbooks.Open("myExcelData.xlsx") 'Picked from msoDialogFilePicker
Dim ws As Worksheet
Set ws = trExcelWB.Sheets(Sheets.Count)
Dim dbDump As DAO.Database
Set dbDump = DBEngine.Workspaces(0).OpenDatabase("backend-database.accdb")
Dim dumpTable as String
dumpTable = "myTableForDataInBackEndDB"
Dim tdf As DAO.TableDef
Set tdf = dbDump.TableDefs(dumpTable)
Dim rst As DAO.Recordset
Set rst = dbDump.OpenRecordset(Name:=dumpTable)
With rst
.AddNew
Dim n as Integer
n = 2
Do While Len(ws.Cells(n,5).Value) > 0 '5th column of dumpSheet stores unique part IDs and governs end of my dataset on the dumpSheet
.AddNew
![Date of Inspection] = ws.Cells(n, 2).Value
![Date of Production] = ws.Cells(n, 3).Value
![LOT] = ws.Cells(n, 4).Value
![Serial] = ws.Cells(n, 5).Value
![Part] = ws.Cells(n, 6).Value
![Depth] = ws.Cells(n, 7).Value
![Wall thickness] = ws.Cells(n, 8).Value
.Update
n = n + 1
Loop
Which works in the case where I have:
Date of Inspection
Date of Production
LOT
Serial
Part
Depth
Wall Thickness
As my field names. These are my headers in only one case of many.
I would like something like this in my Do While Loop:
Do While Len(ws.Cells(n,5).Value) > 0
Dim col as Integer
For col = 2 To ws.UsedRange.Columns.Count
.AddNew
![dbDump.TableDefs(dumpTable).Fields(col - 1).Name] = ws.Cells(n, col).Value
Next col
.Update
n = n + 1
Loop
I get an Error
"Item not found in Collection".
I'm confused because dbDump.TableDefs(dumpTable).Fields(col - 1).Name on its own gives me the name of the field I want as a string, but I cannot figure out how to call it in the dbDump from this code.
I've looked and can't figure out how to loop through field names via index and not name.

Related

Moving data (with duplicates) from one spreadsheet to another

Background: I'm relatively new to VBA, but I see the value in becoming more comfortable using the skillset.
Goal: Move unorganized data (srce) from one spreadsheet into a different more structured spreadsheet (dest) that can later be uploaded into a software application. I have ~500 of these spreadsheets that need to be migrated, so there is an immense amount of time that could be saved by automating this.
Data: The data is a history of truck maintenance. Periodic maintenance takes place throughout the year with multiple services often performed during a single maintenance routine. Under each routine maintenance, there is a date, # of hours on the vehicle when maintenance is performed, and the type of service performed (consistently column "A").
Data Structure: All service types are contained in column A. Starting in column C & D, I have all of the dates the services performed in 2021 from C11:C34. The # of hours the vehicle has operated at the time of maintenance are contained in cells D11:D34. Subsequently, the dates and # of hours for each maintenance in 2022 are contained in columns E and F.
Challenge: While moving down the rows and before switching to the next column, I need to:
Check for repeat dates
Copy the type of services performed at that date
Paste all of those services performed under a single line item in my destination spreadsheet starting in column T and ending in Column Y (In case ~8 services are performed under a single maintenance routine.)
Question:
How can I complete the above challenge without duplicating entries and keep all services performed on the same date within a single line in my dest spreadsheet?
Below is my code thus far (I've left a comment in the section that is where I intended to craft an answer to my dilemma):
Sub VehicleDataExport()
Application.ScreenUpdating = False
'Set reference cell for output called "dest"
Set dest = Sheets("Dest").Range("A2")
'Initialize counter for destination for how many rows down we are so far
dindx = 0
'Set reference cell for source data called "srce"
Set srce = Sheets("Srce").Range("C11")
'Set reference cell for source for how many columns over we are
cindx = 0
'Set the service type index
Set serviceindex = Sheets("Srce").Range("A11")
'Collect name, vin, and in-service date
vehicle_name = Sheets("Srce").Range("A1")
vehicle_vin = Sheets("Srce").Range("B7")
started_at = Sheets("Srce").Range("B8")
'Go over from anchor column while not empty
While srce.Offset(-1, cindx) <> ""
'set row index so that it can restart everytime you switch columns
rindx = 0
'Cycle down through rows until an "DATE" is found
While srce.Offset(rindx, cindx) <> "DATE"
'Set counter for duplicate index so the program will move through the data while looking for duplicate DATES
duplicateindx = 0
'If statement to determine if something is in the cell - 2nd header row
If srce.Offset(rindx, cindx) > 0 Then
'True Case: copy the date, hours, and service type
service_date = srce.Offset(rindx, cindx)
service_hours = srce.Offset(rindx, cindx + 1)
service_type = serviceindex.Offset(rindx, 0)
meter_void = ""
'Properly label and account for Dot Inspection
If service_type = "DOT Inspection" Then
service_hours = 0
meter_void = True
'secondary_meter_value needs to be 0
'secondary_meter_void needs true
End If
'CHECK FOR DUPLICATE DATES AND COPY THEM TO A SINGLE ROW IN THE DESTINATION
'Paste all of the numbers into a destination row
dest.Offset(dindx, 0) = vehicle_name
dest.Offset(dindx, 1) = vehicle_vin
dest.Offset(dindx, 2) = started_at
'Variable inputs
dest.Offset(dindx, 3) = service_date
dest.Offset(dindx, 13) = service_hours
dest.Offset(dindx, 17) = service_type
dest.Offset(dindx, 14) = meter_void
'Add to both the row and destination indexes
rindx = rindx + 1
dindx = dindx + 1
'If no inspection is found, move down one row
Else: rindx = rindx + 1
'End if statement
End If
'end column specific while loop
Wend
'add two to the column index - account for both the date and hours column
cindx = cindx + 2
'End the initial while loop
Wend
Application.ScreenUpdating = True
End Sub
This really sounds like a job for PowerQuery but if I was to tackle it with VBA I'd use a Scripting.Dictionary. I would also write a small data class that includes all of your service types as Boolean.
I don't fully understand your data structure but some pseudo code might look like this:
Const SRVCECOL As Long = 1
Const HOURSCOL As Long = 2
Function ExtractTransformServiceData(src As Workbook) As Object
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim svcDates As Range
Set svcDates = src.Sheets(1).Range("C11:C34")
Dim svcDate As Range
For Each svcDate in svcDates
Dim tsd As TruckServiceData
If dict.Exists(svcDate.Value) Then
Set tsd = dict.Item(svcDate.Value)
Else
Set tsd = New TruckServiceData
dict.Add svcDate.Value, tsd
End If
tsd.SetHoursForService( _
svcDate.Offset(0, SRVCECOL).Value, _
svcDate.Offset(0, HOURSCOL).Value)
Next svcDate
Set ExtractTransformServiceData = dict
End Sub

Reading text in Table Control

I have a problem with SAP VA02 where I want to identify the row line in which a specific label is. In this case the label/text is "Cust. expected price".
I am trying to change the data next to this row, problem is that it is not always the same row, sometimes it is 16, 18, etc.
I am trying to find a way to loop through each row in column 2 in the structure, read the text, and find which row the label is in, then use the row as a variable to paste the price in the correct cell. I have pasted some functioning code below.
What I am doing is inputting the correct price here:
session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\05/ssubSUBSCREEN_BODY:SAPLV69A:6201/tblSAPLV69ATCTRL_KONDITIONEN/txtKOMV-KBETR[3,16]").Text = Price
My main question is how to read what text is in each cell for example session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\05/ssubSUBSCREEN_BODY:SAPLV69A:6201/tblSAPLV69ATCTRL_KONDITIONEN/txtKOMV-KBETR[2,16]")
I can probably figure out the rest from there. I haven't been able to find much regarding this specific structure, any input is appreciated. I will also post a screenshot of the page for reference. Thank you!
Sub OrderRelease()
Dim Order As String
Dim RowCount As Integer
Dim Item As Integer
Dim sh As Worksheet
Dim rw As Range
Dim Sroll As Integer
Dim Price As Double
On Error Resume Next
RowCount = 0
Set sh = ActiveSheet
For Each rw In sh.Rows
If sh.Cells(rw.Row, 6).Value = "" Then
Exit For
End If
RowCount = RowCount + 1
Next rw
If Not IsObject(SAPGuiApp) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPGuiApp = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = SAPGuiApp.Children(0)
End If
If Not IsObject(SAP_session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject SAP_session, "on"
WScript.ConnectObject SAPGuiApp, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nva02"
session.findById("wnd[0]").sendVKey 0
For i = 2 To RowCount
Order = Cells(i, "F")
session.findById("wnd[0]/usr/ctxtVBAK-VBELN").Text = Order
session.findById("wnd[0]/usr/ctxtVBAK-VBELN").caretPosition = 9
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[1]/tbar[0]/btn[0]").press
Continue:
Item = Cells(i, "G") / 10 - 1
Scroll = Item - 1
Price = Cells(i, "H")
Set sub = session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_OVERVIEW/tabpT\02/ssubSU" _
& "BSCREEN_BODY:SAPMV45A:4401/subSUBSCREEN_TC:SAPMV45A:4900")
Set tbl = sub.findById("tblSAPMV45ATCTRL_U_ERF_AUFTRAG")
tbl.verticalScrollbar.Position = Scroll
tbl.getAbsoluteRow(Item).Selected = True
tbl.findById("txtVBAP-POSNR[0,8]").SetFocus
tbl.findById("txtVBAP-POSNR[0,8]").caretPosition = 4
sub.findById("subSUBSCREEN_BUTTONS:SAPMV45A:4050/btnBT_PKON").press
Set tbl2 = session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\05/ssubSU" _
& "BSCREEN_BODY:SAPLV69A:6201/tblSAPLV69ATCTRL_KONDITIONEN")
tbl2.verticalScrollbar.Position = 8
'The below line is what I need to find. In this case, Cust. expected price would be 2,16,
'but I have not found a way to actually read the text in that cell.
tbl2.findById("txtKOMV-KBETR[3,16]").Text = Price
tbl2.findById("txtKOMV-KBETR[3,16]").SetFocus
tbl2.findById("txtKOMV-KBETR[3,16]").caretPosition = 16
session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\11").Select
session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\11/ssubSU" _
& "BSCREEN_BODY:SAPMV45A:4456/cmbVBAP-ABGRU").Key = " "
session.findById("wnd[0]/tbar[0]/btn[3]").press
session.findById("wnd[0]/usr/btnBUT2").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[0]").sendVKey 0
If Cells(i, "F") = Cells(i + 1, "F") Then
i = i + 1
GoTo Continue
End If
session.findById("wnd[0]").sendVKey 11
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/btnSPOP-VAROPTION1").press
Next i
End Sub
Here is how to refer to a value of a cell in a given row and a given column, which are both provided in variables:
row = 0
column = 1
cellText = session.findById(".../tblXXXXX/columnFieldName[" & column & "," & row & "]").Text
Another solution is to use the method GetCell on the Table Control object:
cellText = session.findById(".../tblXXXXX").GetCell(row,column).Text
NB: notice that row and column arguments are switched.
To know what values to use for ".../tblXXXXX/columnFieldName[...], the easiest way is to record a script, by simply moving the cursor to the desired column. The generated script will return something like that (test with the demo program DEMO_DYNPRO_TABCONT_LOOPFLIGHTS):
session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS/ctxtDEMO_CONN-CITYFROM[2,1]").setFocus
session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS/ctxtDEMO_CONN-CITYFROM[2,1]").caretPosition = 1
The row number corresponds to the order among the visible rows, starting from 0 (0 = first visible row). The last visible row has the number equals to the Table Control property VisibleRowCount minus 1. The rows which are not visible (above and below) can be accessed by making your script scroll vertically, for more information about scrolling programatically see below chapter.
The column number is based on the order of columns shown in the Table Control, whatever the columns are immediately visible or visible after horizontal scrolling. The script doesn't need to perform horizontal scrolling to read the values of non-visible columns. 0 is the leftmost column, and the rightmost column has the number equals to the two properties of the Table Control Columns.Count minus 1.
The list of columns and their order may vary according to the active Table Control configuration. You may wish to determine the column number based on the column name at run time, for that see below chapter.
There may be other columns proposed via the Table Control administrator function, with the "hidden" checkbox selected. SAP GUI Scripting completely ignores these columns. If you need to work with them, you must call the table control method ConfigureLayout to display the administrator screen, and then you can work with the settings as you do with any other screen.
Scrolling the rows
For a Table Control, SAP GUI Scripting knows only the data in the lines which are currently visible on the screen, because for performance reason the backend ABAP program sends only these lines to the frontend. SAP GUI Scripting can't know the values from the invisible lines. It's required that the script scrolls vertically to obtain the other rows. Attention, scrolling means the reloading of the whole screen, so the screen elements need to be re-instantiated. The following example scrolls the whole list to display all the values in the first column (use of the demo program DEMO_DYNPRO_TABCONT_LOOPFLIGHTS):
Set tbl = session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS")
' Make the first row visible (show the top of the list) -> that calls the back-end system and screen is reloaded.
' ATTENTION: when the back-end is called, to continue working with screen elements, they must be re-instantiated.
tbl.VerticalScrollbar.Position = 0
TextsOfAllCellsInColumnZero = ""
Do While True
' Re-instantiate the Table Control element (mandatory each time the back-end is called)
Set tbl = session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS")
visibleRow = 0
currentScrollbarPosition = tbl.VerticalScrollbar.Position
While visibleRow < tbl.VisibleRowCount And currentScrollbarPosition <= tbl.VerticalScrollbar.Maximum
TextsOfAllCellsInColumnZero = TextsOfAllCellsInColumnZero & tbl.GetCell(visibleRow,0).Text & Chr(10)
visibleRow = visibleRow + 1
currentScrollbarPosition = currentScrollbarPosition + 1
Wend
If currentScrollbarPosition > tbl.VerticalScrollbar.Maximum Then
Exit Do
End If
tbl.VerticalScrollbar.Position = currentScrollbarPosition
Loop
MsgBox TextsOfAllCellsInColumnZero
Note that this example is suitable to a small number of pages. In many other situations, there are many more pages, for an action like searching a line containing a given value, it would be much more performing to click an existing button to perform a back-end search of this value. The right page would be immediately be displayed.
Determine the column number from the column name at run time
As explained above, the column number may vary depending on the order of columns and on hidden columns. If they vary in an undetermined way at run time, the following code allows to determine the column number based on the column name (note that the lower case prefix of the field name is to be removed, like "ctxt" in "ctxtDEMO_CONN-CITYFROM"), but it works only if there's at least 1 row (no solution found if it's needed when the Table Control is empty):
Set tbl = session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS")
column = GetColumnNumberByName(tbl,"DEMO_CONN-CITYFROM")
msgbox tbl.GetCell(row,column).text
Function GetColumnNumberByName( TableControl, ColumnName )
If TableControl.Rows.Count > 0 Then
For i = 0 To TableControl.Columns.Count - 1
If TableControl.Columns(i)(0).Name = ColumnName Then
GetColumnNumberByName = i
Exit Function
End If
Next
End If
GetColumnNumberByName = -1
End Function
Appendix
For more information, please refer to the documentation of the "GuiTableControl Object" in the SAP Library.
NB: if you look at other questions, be aware that a Table Control (GuiTableControl) is completely unrelated to a Grid View (GuiGridView), so don't be confused.

How do you make a macro find all instances of a value in an excel table?

Not sure if the question makes sense but I'll explain further. I have two sets of data on different excel tabs, one with equipment numbers and another with all of the corresponding information (work orders, priorities, etc.) However, there are some equipment numbers with multiple entries in the other tab. For example equipment number 526176 appears two times. It has two different work order numbers, 6852132 and 6852135. However, my code, which loops through each sheet to find where the information matches and inputs the data in a new tab, only inputs the last instance and shows work order 6852135 twice. It does it with other ones as well. I know that is has to do with the r = r + 1 but isn't sure how. Here's what the code outputs , Here's a screenshot of the 'Dept Master' tab , and Here's the 'Sheet1' tab with all equipment number info. Here is my code:
Sub test6()
Dim sheet1range As Range, masterrange As Range, eqtnumber As Variant, eqtnumber2 As Variant
r = 0
Workbooks("S1 PM Equipment List of JDE Numbers - Master Tool 6-24-2020").Activate
Sheets("Sheet1").Select
Set sheet1range = Sheets("Sheet1").Range(Range("H2"), Range("H2").End(xlDown))
Sheets("Dept Eqt Master").Select
Set masterrange = Sheets("Dept Eqt Master").Range(Range("A2"), Range("A2").End(xlDown))
For Each eqtnumber In masterrange
For Each eqtnumber2 In sheet1range
If eqtnumber = eqtnumber2 Then
Workbooks("Shelby Site Equipment").Sheets("Sheet3").Range("A1").Offset(r, 5).Value = eqtnumber2.Offset(0, -7)
Workbooks("Shelby Site Equipment").Sheets("Sheet3").Range("A1").Offset(r, 6).Value = eqtnumber2.Offset(0, -5)
Workbooks("Shelby Site Equipment").Sheets("Sheet3").Range("A1").Offset(r, 7).Value = eqtnumber2.Offset(0, -2)
Workbooks("Shelby Site Equipment").Sheets("Sheet3").Range("A1").Offset(r, 8).Value = eqtnumber2.Offset(0, -1)
End If
Next eqtnumber2
r = r + 1
Next eqtnumber
Call Macro4
Sheets("Sheet3").Name = "S1 PM Eqt"
End Sub

Creating Excel file with info from database

I have a query that returns something like this:
1 2 3 4 5 6 7
A. B. C. D. E. F. G.
Etc...
Etc...
N rows
I store the query on a dataset. Then I create the Excel file using something like this:
Sql=“select * from table”
Dim cmd As New SqlDataAdapter(Sql, con)
Dim ds As New DataSet
cmd.Fill(ds)
For i=0 To Tables(0).Rows.Count - 1
For x=0 To ds.Tables(0).Columns.Count - 1
ExcelFile.Cells(i+1;x+1)=ds.Tables(0).Rows(i).Item(j)
Next
Next
The code works fine except that I need to write also columns headers name (1,2,3,4,etc.) My first que question is how can I add the headers?
And the main problem... the query sometimes is going to return more than 80k results, so following the for loop logic my code is going to run 80k times for every column (in this case 7 times) which is going to give me a slow result.
There is another fast way to fill and Excel file? Or this is the best way to do it?
You have access to the ColumnName property of each Column in your DataTable. For example, to just add the headers with as little modification of your code as possible, you could just do this:
'Write ColumnName to the corresponding cell in row 1
For x=0 To ds.Tables(0).Columns.Count - 1
ExcelFile.Cells(1, x+1) = ds.Tables(0).Columns(x).ColumnName
Next
'Modded to start at the second row and fix index variable
For i=1 To Tables(0).Rows.Count - 1
For x=0 To ds.Tables(0).Columns.Count - 1
ExcelFile.Cells(i+1, x+1) = ds.Tables(0).Rows(i).Item(x)
Next
Next
You are right to be concerned about the performance of this, though. The number one rule of Excel automation is to actually interact with Excel as little as possible, because each interaction is very expensive.
Assuming you are using regular Office Interop, you should build a 2-dimensional array representing the values from your query. You then find an equivalent size range in your worksheet, and set the value of that range to the array. This way you've cut many thousands of interactions to just one.
Dim rowCount = ds.Tables(0).Rows.Count
Dim colCount = ds.Tables(0).Columns.Count
Dim ws = ExcelFile
Dim valueSet(,) As Object
ReDim valueSet(rowCount - 1, colCount - 1)
For row = 0 To rowCount - 1
For col = 0 To colCount - 1
valueSet(row, col) = ds.Tables(0).Rows(row).Item(col)
Next
Next
'Set the entire set of values in a single operation
ws.Range(ws.Cells(1, 0), ws.Cells(rowCount, colCount).Value = valueSet
Also, if you actually are using Excel Interop or a wrapper around it like NetOffice, you should look into EPPlus and see if it does what you need. It's a helper library that works with OfficeOpenXML and doesn't even require Excel to be installed.
I use the following:
Dim sSql As String
Dim tbl As ListObject
'Declare a Connection object
Dim cnDB As New ADODB.Connection
'Declare a Recordset Object
Dim rs As ADODB.Recordset
' Housekeeping, set the connection strings
Set cnn = New ADODB.Connection
cnn.Provider = "MSDASQL"
cnn.CommandTimeout = 100
Set tbl = ActiveSheet.ListObjects("Lookup")
With tbl.DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
End If
End With
' Connect to the database and paste new data
cnn.ConnectionString = "driver={};server={};uid={};pwd={};database={}"
sSql = "SELECT BLAH BLAH "
cnn.Open
Set rs = cnn.Execute(sSql)
ThisWorkbook.Worksheets("Lookup").Range("A2").CopyFromRecordset rs
cnn.Close

Range in Word keeps changing when tables update

I create multiple tables in word and populate them with data from an excel file.
The coding is done in Excel VBA. I use the Range object in the word document to identify where to insert the next table.
So i add a table, populate it and insert a new row below it.
I then store the end of the current table range as a reference for adding the next table. So far no problem.
But when I insert a lot of data into a table and then change the width of the columns, this takes some time in word. So the reference I stored before might not be valid any more once I want to create the next table.
The whole document changed in the meantime and the position I stored doesn't exist any more. Is there a way around this? Currently I wait for 2 Seconds to not get the error.
Public Function PrintWord(Word, Document, Start As Integer) As Integer
Dim intNoOfRows
Dim intNoOfColumns
intNoOfRows = 7
intNoOfColumns = 2
x = Start
Set objRange = Document.Range(x, x)
Set objTable = Document.Tables.Add(objRange, intNoOfRows, intNoOfColumns)
objTable.Borders.Enable = True
objTable.Cell(1, 1) = [...] ' This is where I populate the table and change the width etc.
Dim y As Integer
Application.Wait (Now + TimeValue("0:00:02")) ' if I wait here, everything works, if not the Range for the next table is some times not valid
y = objTable.Range.End + 1 ' Store the end of the table as a reference for the next one
Document.Range(x, y).ParagraphFormat.SpaceAfter = 3
objTable.Columns(1).PreferredWidthType = 3 ' wdPreferredWidthPoints
objTable.Columns(1).PreferredWidth = Word.CentimetersToPoints(3.5)
objTable.Columns(2).PreferredWidthType = 3 ' wdPreferredWidthPoints
objTable.Columns(2).PreferredWidth = Word.CentimetersToPoints(13)
objTable.Select
Word.Selection.MoveDown Unit:=5, count:=1 ' Move below table
Word.Selection.TypeParagraph
PrintWord = y ' Returns the position for the next Table
End Function

Resources