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

M

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

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
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
 
Upvote 0
Solution
shknbk2 said:
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
Click to expand...
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
 
Upvote 0
mageeg said:
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
Click to expand...
whoops sorry silly question, just realised you reference cell earlier on in the code
 
Upvote 0
shknbk2 said:
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
Click to expand...
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
 
Upvote 0
mageeg said:
When running this code my excel just freezes and doesnt seem to come back.
Click to expand...
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.?
 
Upvote 0
shknbk2 said:
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.?
Click to expand...

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.
 
Upvote 0
Sorry. I guess I had left that out of my code. Glad to see you got it working.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Run Macro for only selected row
Replies
2
Views
487
Suavesav
S
G
  • Question Question
Creating a Word Doc using Excel VBA
Replies
2
Views
328
rikvny02
R
J
  • Question Question
Copy Picture - VBA
2
Replies
10
Views
271
Logit
Logit
C
  • Question Question
Macro run from Excel to transfer data in new Word doc won't output into Word
Replies
5
Views
428
cpu97
C
P
  • Solved
Userform textbox populated with listbox data how to edit
Replies
6
Views
1K
pure vito
P

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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
Back
Top