Import Worksheets Into TextBox

[HTSCF Fareha]

Wasn’t sure whether to put this under Word or Excel, but went with Word as this is where the data needs to end up.

I have two buttons on my Word userform which I need to import a specifically named worksheet table into a specific TextBox. It will not always be necessary to use both buttons, but if they are both used, then the contents of the TextBox should not be overwritten by the other button’s action.

The Excel Workbook will already be open and the worksheets are already named. The tables do not have a fixed number / range of cells. I can move the Dims to the start of the document if this is needed (save on repetition?) after OptionExplicit.

Here is what I have so far, which rather helpfully does nothing when either button is pressed.


' Add Markers Detail

Private Sub MarkersBut_Click()

'Using Early Binding

Dim wordApp As Word.Application
Dim mydoc As Word.Document
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = ActiveSheet("Markers")

' Copying the content from active Excel worksheet named Markers

ThisWorkbook.Worksheets("Markers").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=False, RTF:=False

'Emptying the Clipboard after use

CutCopyMode = False

End Sub

' Add Person Detail

Private Sub PersonBut_Click()

'Using Early Binding

Dim wordApp As Word.Application
Dim mydoc As Word.Document
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = ActiveSheet("Person")

' Copying the content from active Excel worksheet named Person

ThisWorkbook.Worksheets("Person").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=False, RTF:=False

'Emptying the Clipboard after use

CutCopyMode = False

End Sub

[HTSCF Fareha]

Still plugging away at this one. At the moment I'm getting a 'Compile error: Variable not defined' here, when pressing the first button (haven't even bothered with the second button yet) :-


'Create reference to object we want to copy

Set objWorksheet = ActiveWorkbook.Worksheets("Markers")

This is the code that I have for both buttons :-


' Add Markers Detail

Private Sub AggrievedBut_Click()

'Using Early Binding

Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim WrdTbl As Word.Table

Application.ScreenUpdating = False

'Create reference to object we want to copy

Set objWorksheet = ActiveWorkbook.Worksheets("Markers")

' Copying the content from Excel worksheet named Markers

ThisWorkbook.Worksheets("Markers").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

CutCopyMode = False

End Sub

' Add Person Detail

Private Sub PersonBut_Click()

'Using Early Binding

Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim WrdTbl As Word.Table

Application.ScreenUpdating = False

'Create reference to object we want to copy

Set objWorksheet = ActiveWorkbook.Worksheets("Person")

' Copying the content from Excel worksheet named Person

ThisWorkbook.Worksheets("Person").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

CutCopyMode = False

End Sub

I can forsee that even if I could get one of the buttons to work, then clicking on the other to add another table will overwrite the previous one in my Word document's TextBox3.

[HTSCF Fareha]

Here's my latest attempt. I've managed to lose the 'Variable not defined' error. I'm now getting a 'Compile Error : Wrong number of arguments or invalid property assignment' where I've highligted. My VBA knowledge is now exhausted and I'm asking for some help please!


Private Sub MarkersBut_Click()

Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.worksheet
Dim objTable As Table
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")

'Create reference to object we want to copy

Set objWorksheet = ActiveWorkbook.Worksheets("Markers")

' Copying the content from Excel worksheet named Markers

ThisWorkbook.Worksheets("Markers").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

Private Sub PersonBut_Click()

Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.worksheet
Dim objTable As Table
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")

'Create reference to object we want to copy

Set objWorksheet = ActiveWorkbook.Worksheets("Person")

' Copying the content from Excel worksheet named Person

ThisWorkbook.Worksheets("Person").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

[SamT]

VBA errors report the code where the error causes the compiler to fail, not where the coding error is.

"ThisWorkbook" is a code word for "The workbook this code is in" and your code is in a Word Doc.

You have already set objWorksheet to a specific sheet in a specific Workbook, so substitute objWorksheet for

ThisWorkbook.Worksheets("Xxxxxx")in both subs


' Copying the content from Excel worksheet named Xxxxxxx

With objWorksheet
.Range("A1").Select
.Range(Selection, Selection.End(xlToRight)).Select
.Range(Selection, Selection.End(xlDown)).Select.Copy
End with

My personal preference would be to try
' Copying the content from Excel worksheet named Xxxxxxx
objWorksheet.Range("A1").CurrentRegion.Copy

[HTSCF Fareha]

Many thanks for looking at this one, SamT.

I've made the changes as suggested and am now getting a 'Compile error: Invalid use of property' here


ThisWorkbook.Worksheets ("Markers")

Here is the revised code for both Subs


Private Sub MarkersBut_Click()

Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim objTable As Table
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")

'Create reference to object we want to copy

ThisWorkbook.Worksheets ("Markers")

' Copying the content from Excel worksheet named Markers

objWorksheet.Range("A1").CurrentRegion.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

Private Sub PersonBut_Click()

Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim objTable As Table
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")

'Create reference to object we want to copy

ThisWorkbook.Worksheets ("Person")

' Copying the content from Excel worksheet named Person

objWorksheet.Range("A1").CurrentRegion.Copy

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

[SamT]

Post #4
"ThisWorkbook" is a code word for "The [EXCEL] workbook this code is in" and your code is in a Word Doc.

[HTSCF Fareha]

Okay Sam, I understand the point that you make. I might be missing something really obvious, but how do I input the worksheet "Markers" from the workbook "Triage" into my word document macro?

Apologies if I am really missing the obvious. I've commented out the "ThisWorkbook" lines for the time being.


Private Sub MarkersBut_Click()

Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim objTable As Table
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")

' Create reference to object we want to copy

' ThisWorkbook.Worksheets ("Markers")

' Copying the content from Excel worksheet named Markers

objWorksheet.Range("A1").CurrentRegion.Copy

' Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

Private Sub PersonBut_Click()

Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim objTable As Table
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")

' Create reference to object we want to copy

' ThisWorkbook.Worksheets ("Person")

' Copying the content from Excel worksheet named Person

objWorksheet.Range("A1").CurrentRegion.Copy

' Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

' Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

[SamT]

Private Sub MarkersBut_Click() Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.open FullPath & "Triage.xlsx"
Set objWorksheet = objExcel.Workbooks("Triage.xlsx").Sheets("Markers")

objWorksheet.Range("A1").CurrentRegion.Copy

objExcel.Workbooks("Triage.xlsx").Close
Set objWorksheet = Nothing
Set objExcel = Nothing

I'm not 100% that is correct...
At this point, the Clipboard contains the table. I don't know how to put it into Word.

I moved the thread to the Word Forum.

[HTSCF Fareha]

Thanks again, Sam.

I've tweaked your suggested code as below, as the Workbook is in the same folder as the Word document.


Private Sub MarkersBut_Click()

Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "/Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets("Markers")

objWorksheet.Range("A1").CurrentRegion.Copy

objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
Set objExcel = Nothing

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

Private Sub PersonBut_Click()

Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet

Application.ScreenUpdating = False

Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "/Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets("Person")

objWorksheet.Range("A1").CurrentRegion.Copy

objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
Set objExcel = Nothing

'Pasting into the document within TextBox3

TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Emptying the Clipboard

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Application.ScreenUpdating = True

End Sub

I just need some help with getting the two buttons on my Word userform which I need to import the table into the specified TextBox. It will not always be necessary to use both buttons, but if they are both used, then the contents of the TextBox should not be overwritten by the other button’s action.

Once this works, I'll need to repeat the process with another two buttons, but one step at a time.

Thanks!

[Dave]

I guess I'm going to address the seemingly obvious elephant in the room, I've been wrong many times before but I don't think that it's possible to paste an XL table to a text box and if even if U could, why would U? I don't see any reference to listobjects (XL tables) in the code above and both subs above appear identical? What do U really want to do... just display an XL tables on a word userform? Why not just generate a picture of the table and paste it in an image control or frame? Maybe there's an easier method to achieve you're desired outcome rather than the one you're requesting. HTH. Dave

[HTSCF Fareha]

At the moment I am copying and pasting the (two) generated Excel tables into the textbox. Yes, it seems to remove the borders of the tables, but this is what is needed.

I then add some required text to explain the tables (still in the TextBox), complete the rest of my form, then produce the word document. Yes, I agree that this seems a rather convoluted way of producing this, but the final step is to copy all the content of the word document and paste into another bespoke package for which I have no control over.

The main advantage of using this form is that it lays things out correctly, with all the required content and the inputter doesn't miss anything out.

A picture object will not copy into the other package.

[Dave]

I guess don't knock it until U try it and if it works keep doing it would apply here. Back to your needs, I don't quite follow your overwriting concerns and/or how 1 button may overwrite the other... it seems like you need to add some module level boolean variable to act as a key/switch. Maybe in combination with some kind of textbox change event? I see that the above code for the 2 buttons are actually slightly different and maybe could be changed into 1 function which may be useful....

Public Function XLTableToWord(SheetName As String)
Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet

Application.ScreenUpdating = False
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "/Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
objWorksheet.Range("A1").CurrentRegion.Copy
objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
Set objExcel = Nothing


'Pasting into the document within TextBox3
TextBox3(1).Range.Selection.PasteExcelTable _
LinkedToExcel:=False, WordFormatting:=True, RTF:=False


'Emptying the Clipboard
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing


Application.ScreenUpdating = True
End Function
To operate...

Call XLTableToWord("Markers")
Call XLTableToWord("Person")
If you could post a representative XL file with a table that you're using, I'm guessing that SamT, myself or others could create a Word userform to trial and achieve your desired outcome. HTH. Dave

[HTSCF Fareha]

I like the idea of having two separate buttons to import the necessary data into the Textbox, with each button importing the detail held in "Markers" and "Person" (the second button to import a different set of details if required).

There would need to be a fallback of entering a line of text if there was no data in either of the two imported worksheets, along the lines of "No data available".

I've attached the two files, but have had to use dummy text for the workbook to protect sensitive information ;)

[Dave]

The details.docm file doesn't seem to want to open? I'll create my own and kick it around. Dave

[HTSCF Fareha]

I always seem to have trouble adding my word Template files. I changed the .dotm extension to a .docm to get it to upload. Might open if you change it back?

[Dave]

I can't open the document to save as a template. Anyways, a few things. Your table is created by an external data source which is given the named range "Externaldata_1" which can be referred to when copying. Where is your textbox? On the userform or on the document? Either way, I cannot get anymore than 1 line of the copied range to paste in the textbox even though the whole table/named range has been copied to the clipboard. Sorry but I'm giving up. I'll post the code that works to copy the named range/table and pastes the 1st line/row to both a userform textbox and document textbox. The userform has 1 textbox (textbox1) and 2 command buttons and the document has 1 textbox (textbox1). Good luck. HTH. Dave

'userform code
Private Sub CommandButton1_Click()
Call XLTableToWord("Markers")
End Sub


Private Sub CommandButton2_Click()
Call XLTableToWord("Person")
End Sub


Public Function XLTableToWord(SheetName As String)
Dim objExcel As Object
Dim objWorksheet As Object
'Application.ScreenUpdating = False
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
objWorksheet.Range("Externaldata_1").Copy
objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
objExcel.Quit
Set objExcel = Nothing


UserForm1.TextBox1.Paste
ActiveDocument.TextBox1.Paste


'Emptying the Clipboard
'***this DOES NOT empty the clipboard
'Set objWorksheet = Nothing
'Set objWorkbook = Nothing
'Set objExcel = Nothing
'Application.ScreenUpdating = True
End Function

[SamT]

It may be that you have to use PasteSpecial to get access to the Clipboard. It may be that Cut, Copy, and Paste are builtin to Word.

[SamT]

Open a DotM for editing.
Open word. Tell Word to open a file. Set it to Open Only All Word Templates. Open the Details.dotm file



The issue at this (VBAX Thread) stage of program flow is pasting an Excel Range into a VBA UserForm Textbox Control.

When the UserForm is done, the issue will be reading an improper UF Control into the Document's ContentControl, a text range.

I suspect the solution will involve a UF Combo Box control or a UF Spreadsheet Control To display the table on the Form and actually copying the Excel Table to a Word BookMark

[HTSCF Fareha]

My thanks to Dave for taking the time to try and find a solution.

[HTSCF Fareha]

Open a DotM for editing.
Open word. Tell Word to open a file. Set it to Open Only All Word Templates. Open the Details.dotm file



The issue at this (VBAX Thread) stage of program flow is pasting an Excel Range into a VBA UserForm Textbox Control.

When the UserForm is done, the issue will be reading an improper UF Control into the Document's ContentControl, a text range.

I suspect the solution will involve a UF Combo Box control or a UF Spreadsheet Control To display the table on the Form and actually copying the Excel Table to a Word BookMark

Thanks for these words of wisdom, Sam. I only wish I knew what this all meant!!

Oh and to answer Dave's earlier question - the TextBox is in a UserForm.

[SamT]

UserForm: Not part of, just used by, MS Applications like Word and Excel. Can use External additional Controls like Spreadsheet Control.

Details.dotm: Contains a UserForm to hold and display Information, which UserForm does not contain a Control to effectively hold or display an Excel Table or Range.

Details.dotm: Also contains a Word Doc with ContentControls, whose Data is entered programmatically from the UserForm via Sub "FillForm". (Rant, This sub should be named FillContentControls.) Such Sub does not yet have a method to transfer Excel Table to the Word Document.

Problems: The UserForm doesn't contain any Controls suitable for Excel Tables or Ranges. The "reconmmended" method of inserting an Excel Table into a Word Document is to paste the table in.

[HTSCF Fareha]

Thanks for the breakdown of the terminology, Sam. You have made this easy to understand.

I think if I understand your last point, that my problem might not be easily solved?

[SamT]

I discommend downloading custom UserForm Controls.

A UserForm Combobox can be displayed very like a gridless Excel Table, and has a Property that accesses an Excel Range by address.

The code in Details.dotm, ThisDocument Module does not yet properly address the Excel Table Data.

Don't close the UserForm or UserForm Object until the code in Sub FillForm (I mean sub FillControls) is finished. Use the UserForm to return the fullpath, worksheet, and Range address of the table, then copy paste it into the Document at a particular bookmark. This would not affect any current ContentControls or other UserForm Controls.

[HTSCF Fareha]

Frustrated that different Administrators keep moving this thread. :wot

I've managed to keep plugging away at this and have now got to a stage that when the user presses 'CommandButton1', the Excel Workbook named 'Triage' is opened (if it isn't already) and the contents of Worksheets named 'Markers' and 'History' copy their respective contents, then paste directly onto a word document at whatever point the cursor is at.


Private Sub AggdBut_Click()

Dim Excel As Excel.Application, Workbook As Excel.Workbook, Worksheet As Excel.Worksheet, i As Integer
Dim ExcelOpen As Boolean

On Error Resume Next
Set Excel = GetObject(, "Excel.Application") 'Select Excel if open
If Err.Number <> 0 Then 'If Excel is not already open, then open it
Set Excel = CreateObject("Excel.Application")
Else
ExcelOpen = True 'An indicator so we know whether to close Excel or not when finished
End If
On Error GoTo 0

'Open workbook Triage
On Error Resume Next
Set Workbook = Excel.Workbooks.Open(ThisDocument.Path & "/Triage.xlsm")
Workbook.Application.DisplayAlerts = False
If Workbook Is Nothing Then
MsgBox "Unable to open file!"
On Error GoTo 0
GoTo CleanUp
End If
On Error GoTo 0

' First deal with the worksheet Markers
With Workbook.Worksheets("Markers")
'See if there's anything to copy
If .Cells(1, 1) = vbNullString Then
MsgBox "There is nothing to copy!"
GoTo CleanUp
End If

.UsedRange.Copy ' Copy contents of Sheet Markers
Selection.TypeText Text:="These are the records for the past eighteen months" & vbCr & vbCr

Selection.Paste 'Paste sheet Markers into document at cursor
End With
Workbook.Application.DisplayAlerts = False
WordBasic.EditOfficeClipboard
CommandBars("Office Clipboard").Visible = False


' Secondly deal with the worksheet History
With Workbook.Worksheets("History")
'See if there's anything to copy
If .Cells(1, 1) = vbNullString Then
MsgBox "There is nothing to copy!"
GoTo CleanUp
End If

.UsedRange.Copy ' Copy contents of Sheet History
Selection.TypeText Text:="These are the records for the past eighteen months" & vbCr & vbCr

Selection.Paste 'Paste sheet History into document at cursor
End With
Workbook.Application.DisplayAlerts = False
WordBasic.EditOfficeClipboard
CommandBars("Office Clipboard").Visible = False

CleanUp:
If ExcelOpen = False Then Excel.Quit 'close Excel if we started it, otherwise leave open
Workbook.Application.DisplayAlerts = False

Dim oDataObject As DataObject
Set oDataObject = New DataObject
oDataObject.SetText ""
oDataObject.PutInClipboard

Set oDataObject = Nothing
End Sub

Just needing some help now please into how to modify the above so that the contents are pasted directly into TextBox3 of my UserForm in Word.

[HTSCF Fareha]

The following allows me to paste the contents of one part of the clipboard into TextBox3 (the last of the two worksheets, "History") if I place it after
Selection.Paste

It's clear that the first "Markers" worksheet data gets overwritten by the "History" worksheet data.


Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
TextBox3.Text = clipboard.GetText(1)


Could someone please give me some guidance on the process that I will need to place the two worksheets ("Markers" and "History"), along with their respective lines of pre-text ("The following markers are listed" and "These are the records for the past eighteen months") respectively into TextBox3? This should deal with CommandButton1. Although I will need to optionally repeat the process with CommandButton2 with new data. This will also need to be added to TextBox3 without removing the data added by CommandButton1.

I'm guessing that I might need to get each of the contents of the worksheets assigned into a variable, then "join" them together, before getting this into the TextBox3?

My VBA knowledge is not great, although I am determined to persevere!

[SamT]

You can't put a Table in a Textbox. You can only put a single String in a Textbox.

[HTSCF Fareha]

Thanks for your reply, Sam.

I've now modified my code as follows, but am getting a 'Compile error: Sub or Function not defined at
S3 = GetText("formatId3") ' No markers



Private Sub AggdBut_Click()

Dim Excel As Excel.Application, Workbook As Excel.Workbook, Worksheet As Excel.Worksheet, i As Integer
Dim ExcelOpen As Boolean
Dim DataObj As New MSForms.DataObject

' Set default text strings
Dim S1 As String
Dim S2 As String
Dim S3 As String
Dim S4 As String
S1 = "The following markers are listed" & vbCr & vbCr
S2 = "These are the records For the past eighteen months" & vbCr & vbCr
S3 = "There are no markers" & vbCr & vbCr
S4 = "There are no records" & vbCr & vbCr

With DataObj
.SetText S1, "FormatId1"
.PutInClipboard
.SetText S2, "FormatId2"
.PutInClipboard
.SetText S3, "FormatId3"
.PutInClipboard
.SetText S4, "FormatId4"
.PutInClipboard
S1 = vbNullString
S2 = vbNullString
S3 = vbNullString
S4 = vbNullString
End With

' Check if Excel is open

On Error Resume Next
Set Excel = GetObject(, "Excel.Application") 'Select Excel if open
If Err.Number <> 0 Then 'If Excel is not already open, then open it
Set Excel = CreateObject("Excel.Application")
Else
ExcelOpen = True 'An indicator so we know whether to close Excel or not when finished
End If
On Error GoTo 0

' Open workbook Triage

On Error Resume Next
Set Workbook = Excel.Workbooks.Open(ThisDocument.Path & "/Triage.xlsm")
Workbook.Application.DisplayAlerts = False
If Workbook Is Nothing Then
Beep
MsgBox "Unable To open file!"
On Error GoTo 0
GoTo CleanUp
End If
On Error GoTo 0


' First deal with the worksheet Markers

With Workbook.Worksheets("Markers")
'See if there's anything to copy
If .Cells(1, 1) = vbNullString Then
.GetFromClipboard
S3 = GetText("formatId3") ' No markers

Else: .GetFromClipboard
S1 = GetText("formatId1") ' There are markers
End If

End With

' Secondly deal with the worksheet History
With Workbook.Worksheets("History")
'See if there's anything to copy
If .Cells(1, 1) = vbNullString Then
.GetFromClipboard
S4 = GetText("formatId3") ' No history

Else: .GetFromClipboard
S2 = GetText("formatId1") ' There is history
End If

End With

' Paste everything that has been copied into TextBox3
Dim S As String
DataObj.GetFromClipboard
S = DataObj.GetText
TextBox3.Text = clipboard.GetText(1)

CleanUp:
If ExcelOpen = False Then Excel.Quit 'close Excel if we started it, otherwise leave open
Workbook.Application.DisplayAlerts = False
End Sub

' Clear clipboard

Sub ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Sub

[HTSCF Fareha]

Still plugging away... Now getting a 'Runtime error 9 : Subscript out of range' on this line


With Workbook.Worksheets("Markers")

The worksheet exists and is spelt correctly. Argh!!

I appreciate that I will need to address 'Dim S' issue to stop it overwriting itself, but just need to get something pasted into TextBox3 so that I know I'm on the right track.


Private Sub AggdBut_Click()

Dim Excel As Excel.Application, Workbook As Excel.Workbook, Worksheet As Excel.Worksheet, i As Integer
Dim ExcelOpen As Boolean
Dim DataObj As New MSForms.DataObject
Dim MyData As DataObject
Dim S As String

' Set default text strings
Dim S1 As String
Dim S2 As String
Dim S3 As String
Dim S4 As String
S1 = "The following markers are listed" & vbCr & vbCr
S2 = "These are the records for the past eighteen months" & vbCr & vbCr
S3 = "There are no markers" & vbCr & vbCr
S4 = "There are no records" & vbCr & vbCr

With DataObj
.SetText S1, "FormatID1"
.PutInClipboard
.SetText S2, "FormatID2"
.PutInClipboard
.SetText S3, "FormatID3"
.PutInClipboard
.SetText S4, "FormatID4"
.PutInClipboard
S1 = vbNullString
S2 = vbNullString
S3 = vbNullString
S4 = vbNullString
End With

' Check if Excel is open

On Error Resume Next
Set Excel = GetObject(, "Excel.Application") 'Select Excel if open
If Err.Number <> 0 Then 'If Excel is not already open, then open it
Set Excel = CreateObject("Excel.Application")
Else
ExcelOpen = True 'An indicator so we know whether to close Excel or not when finished
End If
On Error GoTo 0

' Open workbook Triage

On Error Resume Next
Set Workbook = Excel.Workbooks.Open(ThisDocument.Path & "/Triage.xlsm")
Workbook.Application.DisplayAlerts = False
If Workbook Is Nothing Then
Beep
MsgBox "Unable to open file!"
On Error GoTo 0
'GoTo CleanUp
End If
On Error GoTo 0

' First deal with the worksheet Markers

With Workbook.Worksheets("Markers")

'See if there's anything to copy
If .Cells(1, 1) = vbNullString Then
S = ("FormatID3") ' No markers
Else: S = ("FormatID1") ' There are markers
End If
End With

' Secondly deal with the worksheet History
With Workbook.Worksheets("History")

'See if there's anything to copy
If .Cells(1, 1) = vbNullString Then
S = ("FormatID4") ' No history
Else: S = ("FormatID2") ' There is history
End If
End With

MyData.GetFromClipboard
TextBox3.Text = MyData.GetText(1)

End Sub

[Dave]

I see that you're still trying for the impossible, and I'm not going to discourage U, but U really should read and re-read SamT's advice. Anyways, it's very bad to use terms such as Excel, Workbook and/or Worksheet as variable names... you're just asking for code failure and/or unexpected results. This should help with your current concerns Good luck. Dave

Set Workbook = Excel.Workbooks.Open(ThisDocument.Path & "/Triage.xlsm")
Set Worksheet = Workbook.Worksheets("Markers")
With Worksheet

[SamT]

need to get something pasted into TextBox3 so that I know I'm on the right track.

Dim X As String
X = "TextBoxes can only contain Strings," & VbCr _
& "Not Tables"
TextBox3 = X

[HTSCF Fareha]

Dave / Sam, I have been so blinkered in trying to find a solution that I think that I haven't properly acknowledged your advice.

I understand that a table cannot be pasted into a TextBox.

I am trying to get the contents of the worksheet into the TextBox (i.e. not bothered about the actual table elements, just the actual text held in the occupied cells). I was close with the code as per post #24, but this wasn't fully achieving my aim of allowing a string of text to be added before the input (this provides an explanation of the text being imported) and allowing this to happen with two imports via the clipboard when pressing a single CommandButton. Post #24 has got the nearest to my desired result, but for only one imported set of table data.


So my aim is to get the following into TextBox3. Other than the two lines of fixed text, the table content will be completely different each time.


Line of text from either 'There are no markers' (No table data to be input if true) or 'These are the markers that are shown' (with something like the following)



High

Allocated from Triage department
16/11/2020


Low
Allocated via resolution
05/11/2020


High
Allocated from Triage department
01/11/2020


Medium
Retrieved from default status

26/10/2020


Low
Allocated via resolution
24/10/2020


Low
Allocated after prior agreement
17/09/2020


Medium
Identified as likely to require further input
03/09/2020



Second line of text from either 'There are no records' (No table data to be input if true) or 'These are the records that have been currently located' (with something like the following)



Subject O1
Intervention was required to obtain the desired result
16/11/2020


Alternative L3
It is highly likely that this might prove cost effective, but might need further input
05/11/2020


Failed T2
This proved negative for all tests
01/11/2020


Failed T3
Exceptionally high costs involved and didn't achieve the desired result
26/10/2020


Subject B5
The nearest test to date that will only require minor adjustment
24/10/2020


Failed S7
A complete non-starter
17/09/2020



It doesn't matter that the text will need to be manually aligned (per column) after the TextBox3 content has been committed to the actual document (obviously if this could be achieved without intervention, then all the better).

[SamT]

Quit trying to drive a nail with a screwdriver.

Place a bookmark in the Word Doc and paste the Excel range at the bookmark

[HTSCF Fareha]

As a former engineer I get the analogy! :eek:

Are we simply saying that the way that I was thinking is making things too complicated? My current form adds various other bits and pieces already so was looking to add this functionality to it. At the moment the user has to copy and paste the contents of each worksheet separately into TextBox3.

Are you suggesting something along these lines to convert the tables to a range, then pasting them into TextBox3?
https://www.mrexcel.com/board/threads/vba-to-convert-a-table-to-a-range.367870/

My VBA knowledge is very limited so I may still miss what you are suggesting.

[SamT]

As a former engineer I get the analogy!Who trained you, Rube Goldberg?

Forget textbox3. Remove it from your mind. Delete it from your code. Tear the T, the X, and the 3 keys off your keyboard

RTFM all the responses to your queries above. Search for "BookMark."

[HTSCF Fareha]

Ha Ha!!

Okay, I think I've finally got it, although I'll be opting for content control instead of bookmarks to place the data. Quite why I felt the need to "view" the contents of the two tables in my form?!?

I'll have a bit of a go with producing some code to achieve output as per post #31

I'll make sure I change my variable names for the Excel related items too!

[SamT]

What you want can actually be done. Just Parse the table directly from Excel and convert it to a Single String that a TextBox can use. I don't know, but you might have to use two Strings, one for a Forms TextBox and one for a Word ContentControl,

You will need two loops (at Least)
For Each Row in Table and
For each Column (Cell) in Row

Add a LineFeed/CarriageReturn for each Row and
Format each Cells Value to a String with spaces to align all "columns" in the Container(s)



What is the shortest distance between two points?





Nobody is helping you because the shortest distance between Excel and Word is well known and documented, but you are insisting that the "Taxi" go from Los Angeles to Sacramento via Paris, France,

[HTSCF Fareha]

Oh dear, I think I'm confusing things again.:(

I'm fully onboard with taking the direct route!- Honest!!! :thumb

'CommandButton1' (as I'm calling it at the moment) should check for and look in the workbook called "Triage" (same folder as the Word Document that the macro is being run from), checking for and copying any cells with data in them from two worksheets ('Markers' and 'History'), adding the lines of text 'There are no markers' (if worksheet 'Markers' is empty) or 'These are the markers that are shown' (with something like the following being input from worksheet 'Markers' as an example)

(PLEASE IGNORE THE ACTUAL TABLE ELEMENT, THIS IS NOT REQUIRED)



High
Allocated from Triage department
16/11/2020


Low
Allocated via resolution
05/11/2020


High
Allocated from Triage department
01/11/2020


Medium
Retrieved from default status
26/10/2020


Low
Allocated via resolution
24/10/2020


Low
Allocated after prior agreement
17/09/2020


Medium
Identified as likely to require further input
03/09/2020




Then a second line of text from either 'There are no records' (if worksheet 'History' is empty) or 'These are the records that have been currently located' (with something like the following being input from worksheet 'History' as an example)



Subject O1
Intervention was required to obtain the desired result
16/11/2020


Alternative L3
It is highly likely that this might prove cost effective, but might need further input
05/11/2020


Failed T2
This proved negative for all tests
01/11/2020


Failed T3
Exceptionally high costs involved and didn't achieve the desired result
26/10/2020


Subject B5
The nearest test to date that will only require minor adjustment
24/10/2020


Failed S7
A complete non-starter
17/09/2020





All the above should then be placed in the word document at the content control called 'Imported Text'. The number of columns is likely to remain constant, however the amount of data could range from a single line to approximately 150 lines or so.

A second button called 'CommandButton2' (for now), if required by the user, will need to perform exactly the same as the above but will obviously have different content data to work with.

Phew!

[HTSCF Fareha]

Following on from Dave's post at #16, I've arrived at the following


Option Explicit

Private Sub cmdInputBut1_Click()
Call XLTableToWord("Markers")
End Sub

Private Sub cmdInputBut2_Click()
Call XLTableToWord("Person")
End Sub
Private Sub cmdInputBut3_Click()
Call XLTableToWord("Markers1")
End Sub

Private Sub cmdInputBut4_Click()
Call XLTableToWord("Person1")
End Sub

Public Function XLTableToWord(SheetName As String)
Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet

Application.ScreenUpdating = False
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "/Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
objWorksheet.Range("A1").CurrentRegion.Copy
'objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
Set objExcel = Nothing

Select Case True
Case SheetName = "Markers": Selection.TypeText Text:="These are the markers shown" & vbCr & vbCr
Selection.Paste 'Paste sheet Markers into document at cursor
Case SheetName = "Person": Selection.TypeText Text:="These are the records shown for the past eighteen months" & vbCr & vbCr
Selection.Paste 'Paste sheet Person into document at cursor
Case SheetName = "Markers1": Selection.TypeText Text:="These are the markers shown" & vbCr & vbCr
Selection.Paste 'Paste sheet Markers1 into document at cursor
Case Else
SheetName = "Person1": Selection.TypeText Text:="These are the records shown for the past eighteen months" & vbCr & vbCr
Selection.Paste 'Paste sheet Person1 into document at cursor

End Select
lbl_Exit:

'Emptying the Clipboard
Dim oData As New DataObject

oData.SetText Text:=Empty
oData.PutInClipboard

Application.ScreenUpdating = True
End Function

I'm getting a 'Runtime error '9': subscript out of range' error on this line


Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)

Hovering over (SheetName) on this line, this shows that the correct worksheet is being referenced.

A major scratching the head moment. Can anyone suggest why this is happening and how to get around it?

Once I get this working I can concentrate on getting the data to fill in at their respective content control points.

Thanks!

[Dave]

Dim objExcel As Object
Dim objWorksheet As Object
HTH. Dave

[HTSCF Fareha]

Sorry, adding these two lines initially produced a duplication error with these lines


Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet

Comment out these two lines then produces the 'Runtime error '9': subscript out of range' on the same line again


Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName) :crying:

[Dave]

I guess I should have checked my originally posted code before my previous post. That code was tested and works... So, do you have sheets in Triage named Person, Person1, Markers & Markers1? Your original test file did not. Whatever happened to your notion of loading the XL table somewhere (in a Textbox... if U can still spell it without those keys :) )and then editing the table before U placed in the Word document? Anyways, I did kick around a method for that by adding the table to a listbox and then using some textboxes to change the listbox selections, but I'm not quite sure that's what U want or how U would want it presented in the document? In table format or something else? One thing at a time, do U have all of those sheet names? Dave
ps. Maybe just use the code here...
Copy & Paste Multiple Excel Tables Into Microsoft Word With VBA — The Spreadsheet Guru (https://www.thespreadsheetguru.com/blog/2014/10/5/multiple-tables-to-word-with-vba)

[HTSCF Fareha]

Hey Dave, I mentioned a few posts back after being given a polite 'nudge' by Sam that I'd ditched the 'load two Excel table's data into TextBox' routine.

Anyway, yes I do have the four worksheets in Triage.xlsm

Although the link you have provided certainly provides a possible solution, I'd really prefer to use Word as the driving program, as the Excel data is only a small part of the form data that the user requires to put into the document.

I cannot see that the code can be too far off, there must be something really "simple" that needs adding or altering.

I've obviously checked that I have the Microsoft Excel 16.0 Object Library selected! :)

[Dave]

As stated that code still works for me. U never answered the question... "Whatever happened to your notion of loading the XL table somewhere (in a Textbox... if U can still spell it without those keys :) )and then editing the table before U placed in the Word document?" ... I thought that was your objective???? Dave
ps. I did say somewhere ie. NOT in a textbox

[HTSCF Fareha]

The actual Excel imported data doesn't need to be altered, just a short piece of text before each of the tables to provide an explanation of what each table contains. To make things easier the text will always be fairly constant, dependent only on which table data is imported into the document.

Hence my thinking of something along the lines of using the Case method (eventually).

If Markers or Markers1 is used, then the text will be "These are the markers shown" & vbCr & vbCr
If Person or Person1 is used, then the text will be "These are the records shown for the past eighteen months" & vbCr & vbCr

If Markers or Markers1 is not used, then the text will be "No records held" & vbCr & vbCr
If Person or Person1 is not used, then the text will be "Currently no records can be found" & vbCr & vbCr

This is why my previous idea of importing into a TextBox is actually not required. My only reason originally was only to add the lines of text as mentioned above. No other reason.


Sorry, I still cannot get your code to work. I must be doing something wrong somehow but I just cannot fathom how.

I'm still hoping that my code in post #38 can be "tweaked" to make it work.

[Dave]

Problem is that #38 will never work! Also that is NOT the code from #16 and I'm guessing if you're running code from #38, U never quit XL and keep calling the function and then U have lots of XL applications still running. Use your task manager to end the processes or there's no chance of any code working. U need to have an external data table with the name of "Externaldata_1" in EVERY sheet for the following code to run. Anyways, apologies for not understanding your outcome objective. I'm assuming that U only want to import 1 table at a time to your document. Code tested and works. Dave
Module code (32 bit instal)...

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Userform code...

Public Function XLTableToWord(SheetName As String)
Dim objExcel As Object, objWorksheet As Object, WordTable As Object
On Error GoTo ErFix
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
objExcel.Range("Externaldata_1").Copy


With ActiveDocument
'clear document
.Range(0, .Characters.Count).Delete
.Content.InsertParagraphBefore


Select Case SheetName
Case "Markers": .Content.InsertBefore "These are the markers shown" '& vbCrLf
Case "Person": .Content.InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
Case "Markers1": .InsertBefore "These are the markers shown" '& vbCrLf
Case "Person1": .InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
End Select
End With
'insert table
With ActiveDocument.Paragraphs.Last.Range
.PasteExcelTable False, False, False
Set WordTable = ThisDocument.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
End With
'clean up
ErFix:
If Err.Number <> 0 Then
On Error Resume Next
MsgBox "Error"
End If
Set WordTable = Nothing
objExcel.DisplayAlerts = False
objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
objExcel.Quit
Set objExcel = Nothing
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function
To operate example...

Call XLTableToWord("Markers")

[HTSCF Fareha]

Thanks for this, Dave!

You are correct in that I did amass a number of Excel applications running at the same time and had to keep closing them! :bug:

Now I've hit upon another slight snag - my limited knowledge of Excel! You mention an "external data table", which I had to perform a Google search on. This is a completely new thing to me, so was thinking how this will accept the data that will need to go into each of the worksheets. Because there is a bespoke third party program, the only option for obtaining the data in the first instance is via an option in this program to "Export as Excel worksheet". It will not allow me to create a direct link to Excel to accept the data. It creates a new instance of Excel with a default sheet name of 'Sheet1'.

I think that I've managed to create these "external data tables", but have noted that they have defaulted to have column headers of 'column1', 'column2' etc. , along with a bit of blue colouring. A couple of questions:-

1) Will these headings and styling be imported into the final tables? This will not be required.

2) Do I just paste from the original source (produced from the bespoke program) into this and then drag a selection around the data that needs to be transferred?

If there is data to export, this will always contain three columns for 'Markers' and 'Markers1' and four columns for 'Person' and 'Person1'. In each case the data could contain anything from a single row up to say a hundred.

I already have a couple of macros to "tidy" the data to remove pointless columns / rows and to apply sorting criteria.

Sorry for all the questions, but my knowledge of VBA is in its infancy and these "external data tables" are also new to me. Determined to get this sorted though!

Thanks!

[Dave]

Please review thread #16. "Because there is a bespoke third party program, the only option for obtaining the data in the first instance is via an option in this program to "Export as Excel worksheet". It will not allow me to create a direct link to Excel to accept the data. It creates a new instance of Excel with a default sheet name of 'Sheet1'." YOU ALREADY HAVE AN "ExterbalData_1" TABLE IN EACH SHEET!!! The exported table is given the named range ExterbalData_1. The XL file U posted does and I assume that every exported sheet will be the same. Go to the name manager box (top left) click the scroll button and U will see ExterbalData_1 there. Click on it and it will highlight your imported table. No need to create anything or link anything. Trial the code with the test file U posted. Dave

[Dave]

Arghh... "I already have a couple of macros to "tidy" the data to remove pointless columns / rows and to apply sorting criteria." The actual imported data has empty column/rows??? I thought that was just a product of U creating a sample wb. You can use the following code to avoid your couple of macros as long as there is always data in A1 and the sheet ONLY has the exported data. The code I provided will continue to include the pointless columns/rows unless you have redefined what the "Externaldata_1" range refers to. I really hate using usedrange as unexpected results occur ie. even if blank cells unrelated to your range of interest have been formatted, XL may decide to include them in your usedrange. Last code and please don't indicate that U want more than 1 table in the document because that's quite a bit different. Dave

Public Function XLTableToWord(SheetName As String)Dim objExcel As Object, objWorksheet As Object, WordTable As Object
On Error GoTo ErFix
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
With objWorksheet
.Activate
.Usedrange.Copy
End With
'objExcel.Range("Externaldata_1").Copy
With ActiveDocument
'clear document
.Range(0, .Characters.Count).Delete
.Content.InsertParagraphBefore


Select Case SheetName
Case "Markers": .Content.InsertBefore "These are the markers shown" '& vbCrLf
Case "Person": .Content.InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
Case "Markers1": .InsertBefore "These are the markers shown" '& vbCrLf
Case "Person1": .InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
End Select
End With
'insert table
With ActiveDocument.Paragraphs.Last.Range
.PasteExcelTable False, False, False
Set WordTable = ThisDocument.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
End With
'clean up
ErFix:
If Err.Number <> 0 Then
On Error Resume Next
MsgBox "Error"
End If
Set WordTable = Nothing
objExcel.DisplayAlerts = False
objExcel.Workbooks("Triage.xlsm").Close
Set objWorksheet = Nothing
objExcel.Quit
Set objExcel = Nothing
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function

[HTSCF Fareha]

Sorry for the slow reply, Dave - VBA Express Forum has been playing up for me today. :dunno

Many thanks for this latest code!

I do have to run a couple of Macros from Excel to do some tidying and arranging. You're not going to like me, but yes, my word document could have from one to four of these tables, depending on the user's requirement.

My Macros always ensure that data is in cell A1, but will require my macros. These are as follows:-

First for Markers (& Markers1)


Sub Markers()

' Check for cells in column D that contain 'To'
' If any cells do then delete column

Dim Cell As Range, ws As Worksheet

Set ws = Sheets("Markers")

For Each Cell In ws.Range("$D:$D")
Cell.Value = "To"
Cell.EntireColumn.Delete
Next Cell

' Format date in column C
Range("$C:$C").NumberFormat = "dd/mm/yyyy"

' Delete first three rows
Sheets("Markers").Range("$1:$3").EntireRow.Delete

' Sort Markers
Dim rData As Range, rData1 As Range, rData2 As Range
Dim r As Long, i As Long, iLastSort As String
Dim arySorts As Variant
Dim sLastSort As String

arySorts = Array("Checked", "Ignored", "Important", "Untested", "Trial") ' starts at 0

Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)

Application.AddCustomList ListArray:=arySorts

With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rData1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=Application.CustomListCount
.SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
.SetRange rData
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With

Set rData2 = Nothing
With rData

'see which last sort is in data
For i = UBound(arySorts) To LBound(arySorts) Step -1
iLastSort = -1
On Error Resume Next
iLastSort = Application.WorksheetFunction.Match(arySorts(i), Application.WorksheetFunction.Index(rData, 0, 2), 0)
On Error GoTo 0

'found custom sort value
If iLastSort > -1 Then
sLastSort = LCase(arySorts(i))
Exit For
End If
Next i
End With

'custom sort value found
If Len(sLastSort) > 0 Then

With rData
For r = .Rows.Count To 3 Step -1
If LCase(.Cells(r, 2).Value) = sLastSort Then
Set rData2 = .Cells(r + 1, 1)
Set rData2 = Range(rData2, rData2.End(xlDown).End(xlToRight))
Exit For
End If
Next
End With

'MsgBox rData2.Address
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
.SetRange rData2
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With

End If

Application.DeleteCustomList ListNum:=Application.CustomListCount

' Delete first column
Sheets("Markers").Range("$A:$A").EntireColumn.Delete

End Sub

The second for Person (& Person1)


Option Explicit
Sub Triage()

' Triage Macro

'Delete any row containing the words 'Z INFORMATION SHARING' in column D
Dim i As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If InStr(Cells(i, 4), "Z INFORMATION SHARING") Then
'If InStr(Cells(i, 4), "Z INFORMATION SHARING") Or InStr(Cells(i, 4), "Abcdef") Then
Rows(i).Delete
End If
Next


'Perform the basic editing
'Delete first column

Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

' Find and remove all instances of [O]

Columns("B:B").Select
Selection.Replace What:=" [O]", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'Format date column

Range("$D:$D").NumberFormat = "dd/mm/yyyy"

'Delete columns not required

Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=-1
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("A1").Select

'Delete all rows with a date older than eighteen months
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False
Dim FilterRange As Range, myDate As Date
myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
Set FilterRange = _
Range("D:D" & Cells(Rows.Count, 1).End(xlUp).Row)
FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
On Error Resume Next
With FilterRange
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
End With
Err.Clear
Set FilterRange = Nothing
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True


'Select all remaining cells with data in them
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

End Sub

[Dave]

:igiveup: Good luck. Be Safe. Dave

[SamT]

Glad to see you made it back, Alice.:mayi:

[HTSCF Fareha]

I'm really sorry about not being clear about the requirement of needing anything from 1 to 4 tables, Dave. :sad2:

[HTSCF Fareha]

I've managed to rename each of the tables by producing another sub. Each of the tables is now named as Markers, Markers1, Person and Person1, as are each of the worksheets.

Just need to know how to change the final line of this code so that the relevant table is copied to the clipboard. The final line is producing a 'Compile error: Method or data member not found'.


Hoping that this is possible? I should be able to take things from there. Thanks!


Public Function XLTableToWord(SheetName As String)
Dim objExcel As Object, objWorksheet As Object, WordTable As Object, objName As Object
On Error GoTo ErFix
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
Sheets.Range(SheetName).Copy

[SamT]

The Excel Collection Object "Sheets" does not have a "Range" Property (Data Member or Method)

Learn what F2 in VBA has to offer

[Dave]

Stupid rabbit with that shiny watch... see #16, #45 & #48

objExcel.Range(SheetName).Copy
Dave

[HTSCF Fareha]

:o:

What can I say? Thanks, Dave!