Help with repeating macro's

[WIGG77]

Hello,

First post here so brief introduction.
My name is Dave and I work for a UK based company who design and manufacture bespoke hand built wheelchairs.

I am by no means an Excel god and have only really been using the program for around 6 months.

I set out to create a simple workbook to track the wheelchairs through the various stages of our manufacture with a simple tick box system and a click button to confirm the chair is ready for despatch. When the button is clicked an email is created and sent to the relevant recipients with certain cells from the sheet copied into the body of the mail. I use the workbook as a shared file between 2 people.

So far so good.

I use 1 sheet for each week and after adding the next 6 weeks or so, with 35-40 lines on each week the workbook gets somewhat clunky and slow. Each click button is assigned a separate macro and I guess this could be the route of my problem. If I use this workbook with other Excel documents open which link to MS Project, I often get the white screen crash or a complete system lockup. I patched together the VBA from other code people had posted here and there on the internet and adapted it to suit my needs.

As the code just repeats is there a way to streamline it but still retain the ability the copy the correct cells into the email body? Is there a way to copy the same cells but using th row the button is on?

Any help or advise would be greatly appreciated.

Dave

(I wasnt sure of the best way to upload the book so added a link to the file from my Dropbox)


https://dl.dropboxusercontent.com/u/13653846/Prod Progress.xlsb

 

[Michael M]

whoops....wrong variable

Sub MM1()
Dim ans As Range
Set ans = Application.InputBox("Which Chair is ready for Despatch, please Select a cell in Column B", "Chair Selection", Type:=8)
If MsgBox("Do you wish to mark " & ans & " as ready for despatch?", vbYesNo) = vbNo Then Exit Sub
   ans = ans.Address(False, False)
bdy = ans.Offset(, -1).Address(False, False) & ":" & ans.Offset(, 2).Address(False, False)
   ActiveWorkbook.EnvelopeVisible = True
   With ActiveSheet.MailEnvelope
      .Introduction = "This wheelchair has passed final inspection and is cleared for delivery."
      .Item.To = ""
      .Item.CC = ""
      .Item.Subject = ans & " / " & ans.Offset(, 1) & " is ready for despatch"
      .Item.Send
   End With
End Sub

 

[WIGG77]

Still no good my friend.

It now changes the selected cell from the inputbox to the cell name (B3,B4 etc.) which results in 'B3' in the subject field instead of the chair serial number & still copies the whole sheet into the email body instead of the required cell from the selected row.

 

[Michael M]

Mate, I'm really sorry....I don't have Excel at the moment, so flying blind and can't test
From memory, the bdytxt needs to be the 3 cells from the active row from Col "A" to "D"...is that correct ??

Sub MM1()
Dim ans As Range
Set ans = Application.InputBox("Which Chair is ready for Despatch, please Select a cell in Column B", "Chair Selection", Type:=8)
If MsgBox("Do you wish to mark " & ans & " as ready for despatch?", vbYesNo) = vbNo Then Exit Sub
bdytxt = ans.Offset(, -1).Value & " " & ans.Value & " " & ans.Offset(, 1).Value &" "& ans.Offset(, 2).Value
   ActiveWorkbook.EnvelopeVisible = True
   With ActiveSheet.MailEnvelope
      .Introduction = "This wheelchair has passed final inspection and is cleared for delivery."
      .Item.To = ""
      .Item.CC = ""
      .Item.Subject = ans & " / " & ans.Offset(, 1) & " is ready for despatch"
      .Item.Send
   End With
End Sub

 

[WIGG77]

Hey no need to apologize. I appreciate all the help you are are giving.

Yes that correct cells 'A' to 'D' from the selected row.

 

[Michael M]

Okay, well that last code should get us darn close !!

 

[WIGG77]

Arrgghh. SO close indeed. Its not changing the text in the inputbox cell but still including the whole sheet in mail body

 

[Michael M]

Grrr....try this then

Sub MYKL1()
Dim ans As Range
Set ans = Application.InputBox("Which Chair is ready for Despatch, please Select a cell in Column B", "Chair Selection", Type:=8)
ans.Select
If MsgBox("Do you wish to mark " & ans & " as ready for despatch?", vbYesNo) = vbNo Then Exit Sub
ActiveSheet.Range(ans.Offset(, -1), ans.Offset(, 2)).Select
   ActiveWorkbook.EnvelopeVisible = True
   With ActiveSheet.MailEnvelope
      .Introduction = "This wheelchair has passed final inspection and is cleared for delivery."
      .Item.To = ""
      .Item.CC = ""
      .Item.Subject = ans & " / " & ans.Offset(, 1) & " is ready for despatch"
      '.Item.Send
   End With
End Sub

 

[WIGG77]

Micheal, you are a legend! I can't thank you enough.

One more thing. Is it possible to add an .pdf attachment to the email that uses the input box selection as the filename? I've been using '.Item.Display' instead of 'Item.Send' so I can attach the pdf when the mail shows, but thats rather long winded.

Thanks again

 

[Michael M]

What's the pdf attachment?
a seperate file to the data on the sheet, the active sheet, or what ??

 

[WIGG77]

Yes separate files in one folder on our server
Its just a scan of the order and filename is always the same as the wheelchair serial number. ABC123, ABC124 etc.