Macro to print certain info from XL sheet

Completed Posted 6 years ago Paid on delivery
Completed Paid on delivery

I have a worksheet with various names in Column B, and have a macro that goes through this column and finds certain words within the names – for instance “pears” and copies and pastes each row into a second sheet, from which I then manually mail merge that row which contains address’s with a word document – for instance [url removed, login to view] to then print.

I want to automate this process, so that the macro finds several words – pears/apples/bananas, and then draws on several letter documents – [url removed, login to view], [url removed, login to view], [url removed, login to view] and mail merges all for printing with a specific printer..

My current (and simple macro) is as follows with the first page of my spreadsheet being called “Query 1”, and second page “ToCopy” :-

____________________________________________________________________________

Sub macropears()

'this variable holds a search phrase, declared as variant as it might be text or number

Dim vSearch As Variant

'these three variables are declared as long, technically the loop might exceed 32k (integer) therefore it is safer to use long

Dim i As Long

Dim k As Long

Dim lRowToCopy As Long

'varialbe i initially declared as 1 - macro starts calculations from the 1st row

i = 1

'macro will loop until it finds a row with no records

'I called a standard XLS function COUNTA to count the number of non-blank cells

'if the macro finds a row with no records it quits the loop

Do Until [url removed, login to view](Sheets("Query 1").Rows(i)) = 0

'here I let the macro to continue its run despite a possible errors (explanation below)

On Error Resume Next

lRowToCopy = 0

lRowToCopy = Sheets("Query 1").Rows(i).Columns("B:B").Find(What:="pears", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Row

'here we allow macro to disiplay error messages

On Error GoTo 0

'if var lRowToCopy does not equal to 0 that means a row with a searched value has been found

If lRowToCopy > 0 Then

'this loop looks for the first blank row in 2nd sheet, I also used COUNTA to find absolutely empty row

For k = 1 To Sheets("ToCopy").[url removed, login to view]

'when the row is found, the macro performs copy-paste operation

If [url removed, login to view](Sheets("ToCopy").Rows(k)) = 0 Then

Sheets("Query 1").Rows(i).Copy

Sheets("ToCopy").Select

Rows(k).Select

[url removed, login to view]

'do not forget to exit for loop as it will fill all empty rows in 2nd sheet

Exit For

End If

Next k

End If

i = i + 1

Loop

End Sub

________________________________________________________________________________

I look forward to receiving proposals.

Have just realised that I do not need to mail - merge, I just need new files creted called apples/pears/bananas automatically as the print software i am usinging is "mail merged" at the printer end - see attached - if anyone can automate a program to print each letter to each spreadsheet row in one go, then this will of course be preferable.

Excel Microsoft Software Architecture Word

Project ID: #13603474

About the project

4 proposals Remote project Active 6 years ago

Awarded to:

£20 GBP in 1 day
(1 Review)
0.8

4 freelancers are bidding on average £22 for this job

ksriniravi

Greetings! I can help with developing a macro for generation of word documents as required. I have 17+ years experience in using Excel as part of my daily work life. In the process I have implemented lot of autom More

£20 GBP in 1 day
(61 Reviews)
5.4
zebracaro

i can do it for you quickly and exactly

£28 GBP in 1 day
(71 Reviews)
5.6
pgbhughes

It seems like you have done most of the work. To be honest this is not that difficult, so I am sure you probably could end up doing it yourself based on the code (although it could be a little more streamlined). What I More

£20 GBP in 2 days
(11 Reviews)
3.8