Macro to print certain info from XL sheet
£10-20 GBP
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.
Project ID: #13603474
About the project
Awarded to:
4 freelancers are bidding on average £22 for this job
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