Transferring Data from Excel to Word based on a criteria from database

mageeg

Board Regular
Joined
Jun 6, 2021
Messages
81
Hi all, I have some code which transfers data in my excel database into a table in word. At the moment it does this for every row in the database.

See code:

VBA Code:
Set wd = CreateObject("Word.Application")

'Set worksheet

Set sh = ThisWorkbook.Sheets("Database")

iRow = 2 'row in which data starts from in database

Do While sh.Range("A" & iRow).Value <> ""  'loop through records till value is blank (end of data)

'opening word template

Set wdDOC = wd.Documents.Add("T:\mageeg\TEST DATA  INSPECTION SCHEDULE Issue 3.docx")

wd.Visible = False

'code to insert values from database to bookmarks in word

wd.Selection.GoTo what:=wdGoToBookmark, Name:="PartNo"
wd.Selection.TypeText Text:=sh.Range("C" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="Serial"
wd.Selection.TypeText Text:=sh.Range("E" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="ModelNo"
wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="WorksOrderNo"
wd.Selection.TypeText Text:=sh.Range("D" & iRow).Value

'save file with new name

wdDOC.SaveAs2 (ThisWorkbook.Path & "\" & sh.Range("D" & iRow).Value & ".docx")

'close the word file

wdDOC.Close

'release memory of word doc

Set wdDOC = Nothing


iRow = iRow + 1

Loop

wd.Quit 'close MS Word

Whilst this works great, what i would like to do is only perform one transfer, based on a certain criteria.. the "Works Order Number" as this field is unique.

I would like the user to be able to enter a works order number and then it take just this row of the database and transfer it to Word.

I'm not sure how to go about doing this, any advice would be much appreciated!


EDIT: I was thinking maybe i could have the user type the works order number in a cell, and then the code picks it up from the cell and prints that row, not sure how to go about doing this though.
 
Last edited by a moderator:

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

shknbk2

Active Member
Joined
Mar 5, 2016
Messages
386
Office Version
  1. 365
Platform
  1. Windows
Using your suggestion of the user putting the desired word order in a cell, I think this would work. You need to change the "WorkOrder =" line so that the value from whichever cell you set up to be the entry cell is referenced. I didn't know if you wanted that cell also on worksheet "Database".
VBA Code:
Dim WorkOrder As String
Set wd = CreateObject("Word.Application")

'Get user-entered work order
WorkOrder = Worksheets("WHICH").Range("A1").Value

'Set worksheet
Set sh = ThisWorkbook.Sheets("Database")
iRow = 2 'row in which data starts from in database

Do While sh.Range("A" & iRow).Value <> ""  'loop through records till value is blank (end of data)
    'check to see if WorkOrder matches
    If WorkOrder = sh.Range("D" & iRow).Value Then
        'opening word template
        Set wdDOC = wd.Documents.Add("T:\mageeg\TEST DATA  INSPECTION SCHEDULE Issue 3.docx")
        wd.Visible = False
        'code to insert values from database to bookmarks in word
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="PartNo"
        wd.Selection.TypeText Text:=sh.Range("C" & iRow).Value
        
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="Serial"
        wd.Selection.TypeText Text:=sh.Range("E" & iRow).Value
        
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="ModelNo"
        wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value
        
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="WorksOrderNo"
        wd.Selection.TypeText Text:=sh.Range("D" & iRow).Value
        
        'save file with new name
        wdDOC.SaveAs2 (ThisWorkbook.Path & "\" & sh.Range("D" & iRow).Value & ".docx")
        
        'close the word file
        wdDOC.Close
        
        'release memory of word doc
        Set wdDOC = Nothing
        
        Exit Do
    End If
Loop

wd.Quit 'close MS Word
 
Solution

mageeg

Board Regular
Joined
Jun 6, 2021
Messages
81
Using your suggestion of the user putting the desired word order in a cell, I think this would work. You need to change the "WorkOrder =" line so that the value from whichever cell you set up to be the entry cell is referenced. I didn't know if you wanted that cell also on worksheet "Database".
VBA Code:
Dim WorkOrder As String
Set wd = CreateObject("Word.Application")

'Get user-entered work order
WorkOrder = Worksheets("WHICH").Range("A1").Value

'Set worksheet
Set sh = ThisWorkbook.Sheets("Database")
iRow = 2 'row in which data starts from in database

Do While sh.Range("A" & iRow).Value <> ""  'loop through records till value is blank (end of data)
    'check to see if WorkOrder matches
    If WorkOrder = sh.Range("D" & iRow).Value Then
        'opening word template
        Set wdDOC = wd.Documents.Add("T:\mageeg\TEST DATA  INSPECTION SCHEDULE Issue 3.docx")
        wd.Visible = False
        'code to insert values from database to bookmarks in word
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="PartNo"
        wd.Selection.TypeText Text:=sh.Range("C" & iRow).Value
       
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="Serial"
        wd.Selection.TypeText Text:=sh.Range("E" & iRow).Value
       
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="ModelNo"
        wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value
       
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="WorksOrderNo"
        wd.Selection.TypeText Text:=sh.Range("D" & iRow).Value
       
        'save file with new name
        wdDOC.SaveAs2 (ThisWorkbook.Path & "\" & sh.Range("D" & iRow).Value & ".docx")
       
        'close the word file
        wdDOC.Close
       
        'release memory of word doc
        Set wdDOC = Nothing
       
        Exit Do
    End If
Loop

wd.Quit 'close MS Word
Hi! thanks for suggestion,

Sorry for the noob question...

would that line of code then look like this?

VBA Code:
If WorkOrder = sh.Range("D26" & iRow).Value Then
 

mageeg

Board Regular
Joined
Jun 6, 2021
Messages
81
Hi! thanks for suggestion,

Sorry for the noob question...

would that line of code then look like this?

VBA Code:
If WorkOrder = sh.Range("D26" & iRow).Value Then
whoops sorry silly question, just realised you reference cell earlier on in the code
 

mageeg

Board Regular
Joined
Jun 6, 2021
Messages
81

ADVERTISEMENT

Using your suggestion of the user putting the desired word order in a cell, I think this would work. You need to change the "WorkOrder =" line so that the value from whichever cell you set up to be the entry cell is referenced. I didn't know if you wanted that cell also on worksheet "Database".
VBA Code:
Dim WorkOrder As String
Set wd = CreateObject("Word.Application")

'Get user-entered work order
WorkOrder = Worksheets("WHICH").Range("A1").Value

'Set worksheet
Set sh = ThisWorkbook.Sheets("Database")
iRow = 2 'row in which data starts from in database

Do While sh.Range("A" & iRow).Value <> ""  'loop through records till value is blank (end of data)
    'check to see if WorkOrder matches
    If WorkOrder = sh.Range("D" & iRow).Value Then
        'opening word template
        Set wdDOC = wd.Documents.Add("T:\mageeg\TEST DATA  INSPECTION SCHEDULE Issue 3.docx")
        wd.Visible = False
        'code to insert values from database to bookmarks in word
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="PartNo"
        wd.Selection.TypeText Text:=sh.Range("C" & iRow).Value
       
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="Serial"
        wd.Selection.TypeText Text:=sh.Range("E" & iRow).Value
       
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="ModelNo"
        wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value
       
        wd.Selection.GoTo what:=wdGoToBookmark, Name:="WorksOrderNo"
        wd.Selection.TypeText Text:=sh.Range("D" & iRow).Value
       
        'save file with new name
        wdDOC.SaveAs2 (ThisWorkbook.Path & "\" & sh.Range("D" & iRow).Value & ".docx")
       
        'close the word file
        wdDOC.Close
       
        'release memory of word doc
        Set wdDOC = Nothing
       
        Exit Do
    End If
Loop

wd.Quit 'close MS Word
Whilst this looks like it should work,

When running this code my excel just freezes and doesnt seem to come back.

This is how it looks now

VBA Code:
Dim wd As Object 'Word Application
Dim wdDOC As Object 'word document
Dim iRow As Long 'Variable to hold the starting row and loop through all records in database
Dim PercentageScore As Variant 'Variable to hold percentage score
Dim sh As Worksheet 'worksheet variable to refer  to where database is stored
Dim myValue As Variant
Dim WorkOrder As String

'Start word as new document

Set wd = CreateObject("Word.Application")

'Set worksheet

Set sh = ThisWorkbook.Sheets("Database")

WorkOrder = sh.Range("D26").Value

iRow = 2 'row in which data starts from in database

Do While sh.Range("A" & iRow).Value <> "" 'loop through until...
 If WorkOrder = sh.Range("D" & iRow).Value Then

'opening word template

Set wdDOC = wd.Documents.Add("T:\mageeg\TEST DATA  INSPECTION SCHEDULE Issue 3.docx")

wd.Visible = False

'code to insert values from database to bookmarks in word

wd.Selection.GoTo what:=wdGoToBookmark, Name:="PartNo"
wd.Selection.TypeText Text:=sh.Range("C" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="Serial"
wd.Selection.TypeText Text:=sh.Range("E" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="ModelNo"
wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="WorksOrderNo"
wd.Selection.TypeText Text:=sh.Range("D" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="MaterialNo"
wd.Selection.TypeText Text:=sh.Range("F" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="SerialNo"
wd.Selection.TypeText Text:=sh.Range("E" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="ModelNo2"
wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="Type"
wd.Selection.TypeText Text:=sh.Range("H" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="Size"
wd.Selection.TypeText Text:=sh.Range("I" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="WKPRESS"
wd.Selection.TypeText Text:=sh.Range("J" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="SerialNumber"
wd.Selection.TypeText Text:=sh.Range("G" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="CertDate"
wd.Selection.TypeText Text:=sh.Range("K" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="BatchNo"
wd.Selection.TypeText Text:=sh.Range("L" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="JobNo"
wd.Selection.TypeText Text:=sh.Range("M" & iRow).Value

wd.Selection.GoTo what:=wdGoToBookmark, Name:="DateOfManufacture"
wd.Selection.TypeText Text:=Format(sh.Range("N" & iRow).Value, "mmm-yy")


'code to delete the existing bookmarks from wordfile

On Error Resume Next

wdDOC.Bookmarks("PartNo").Delete
wdDOC.Bookmarks("SerialNo").Delete
wdDOC.Bookmarks("ModelNo").Delete
wdDOC.Bookmarks("WorksOrderNo").Delete
wdDOC.Bookmarks("MaterialNo").Delete
wdDOC.Bookmarks("Serial").Delete
wdDOC.Bookmarks("ModelNo2").Delete
wdDOC.Bookmarks("Type").Delete
wdDOC.Bookmarks("Size").Delete
wdDOC.Bookmarks("WKPRESS").Delete
wdDOC.Bookmarks("SerialNumber").Delete
wdDOC.Bookmarks("CertDate").Delete
wdDOC.Bookmarks("BatchNo").Delete
wdDOC.Bookmarks("JobNo").Delete
wdDOC.Bookmarks("DateOfManufacture").Delete

'save file with new name

wdDOC.SaveAs2 (ThisWorkbook.Path & "\" & sh.Range("D" & iRow).Value & ".docx")

'Print document


'close the word file

wdDOC.Close

'release memory of word doc

Set wdDOC = Nothing

iRow = iRow + 1

Exit Do

End If

Loop

wd.Quit 'close MS Word

Set wd = Nothing 'Release memory allocated to WD

MsgBox ("Inspection Test Sheet Created")

End Sub
 

shknbk2

Active Member
Joined
Mar 5, 2016
Messages
386
Office Version
  1. 365
Platform
  1. Windows
When running this code my excel just freezes and doesnt seem to come back.
It sounds like the code might be stuck inside the Do loop without exiting.

A little debugging might tell you why it is not working. Put the cursor anywhere in the code, and hit F8. A yellow line will show up, and it indicates the line that will execute when you hit F8 again. Keep hitting F8 to step through each line one at a time. You can put the mouse cursor over a variable and a little popup display will show its current value. For example, when the yellow line gets to If WorkOrder = sh.Range("D" & iRow).Value Then, put the cursor over Value to see what its value is interpreted as by the code.

You can also keep tabs on iRow and the value in sh.Range("A" & iRow).Value as well.

I'm curious about this line in your code:
VBA Code:
WorkOrder = sh.Range("D26").Value
Is it a standalone cell somewhere on the sheet apart from the data beginning in A2? Does that data go to or past row 26? Is this the cell that the user would enter the desired work order number in or is it a part of the data that already has a work order tied to a particular part number, serial, etc.?
 

mageeg

Board Regular
Joined
Jun 6, 2021
Messages
81
It sounds like the code might be stuck inside the Do loop without exiting.

A little debugging might tell you why it is not working. Put the cursor anywhere in the code, and hit F8. A yellow line will show up, and it indicates the line that will execute when you hit F8 again. Keep hitting F8 to step through each line one at a time. You can put the mouse cursor over a variable and a little popup display will show its current value. For example, when the yellow line gets to If WorkOrder = sh.Range("D" & iRow).Value Then, put the cursor over Value to see what its value is interpreted as by the code.

You can also keep tabs on iRow and the value in sh.Range("A" & iRow).Value as well.

I'm curious about this line in your code:
VBA Code:
WorkOrder = sh.Range("D26").Value
Is it a standalone cell somewhere on the sheet apart from the data beginning in A2? Does that data go to or past row 26? Is this the cell that the user would enter the desired work order number in or is it a part of the data that already has a work order tied to a particular part number, serial, etc.?

Thanks for your help :) i figured it out earlier. The code was only incrementing iRow if the value is found. Otherwise it would check the same row over and over again.

All i had to do was move the iRow = iRow + 1 line after the End If.
 

shknbk2

Active Member
Joined
Mar 5, 2016
Messages
386
Office Version
  1. 365
Platform
  1. Windows
Sorry. I guess I had left that out of my code. Glad to see you got it working.
 

Forum statistics

Threads
1,144,522
Messages
5,724,831
Members
422,582
Latest member
Vaibhav Wadhwa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top