Deleting unuse row before transfering into pdf

michellin

Board Regular
Joined
Oct 4, 2011
Messages
57
Office Version
  1. 2019
Platform
  1. Windows
Hy guys/girls,

I'm working on a order sheet for my cook at my school to make is life easyer, it a surprise.

I already got some macro that i'm taking from other part of project to make this one happen.

My macro copy my sheet, next to sheet 2, to never scrap my orignal sheet.

On my copy sheet i want to delete unused row if no quantity in a specific cell, but skiping all the header, like this my sheet will be shorter.

But i'm stuck on that part. I'm pretty sure one of you will find a way to do it.

I'm using A to J to 680.
I got all my title, and info for the order from row 1 to 11, i don't want to touch. I never pass J column.

All start here, i got line 12 and 13 is a header, line 14 to 48 i want to delete row if nothing in C cell on that row.
Then stop for next header line 49 and 50. And deleting row form line 51 to 70 if nothing is found in C cell
Then stop for next header line 71 and 72. And deleting row form line 73 to 103 if nothing is found in C cell
Then stop for next header line 104 and 105. and again and again till last line a 680. (if we need it i can give you all the line for those header or look at the end all the line i want to ''delete'' are there)

after that my macro can transfert it to pdf and attach it on an e-mail then ship it, then erase the copy sheet, and erase all c cell in the original sheet.

I hope you can help me :-) Thanks in advance

Here what i got from now :


Sub Automationdubort()

Sheets("Dubort Et Rainville").Select
ActiveSheet.Unprotect Password:="1234"

'printer pdf
CreateObject("WScript.Network").SetDefaultPrinter "PDFCreator"

'add date in cell
Sheets("Dubort Et Rainville").Select
Range("D7").Select
Selection.ClearContents
Selection.NumberFormat = "yyyy-mm-dd"
ActiveCell = Now

'copy in pdf
Sheets("Dubort Et Rainville").Select
Application.CopyObjectsWithCells = True
Sheets("Dubort Et Rainville").Copy After:=Sheets(2)
strDate = Format(Date, "yyyy-mm-dd")

With ActiveSheet
.Name = strDate & "-" & Range("B3") & "-" & Range("D9")
End With

' copy to lan folder
ActiveSheet.Select
ActiveSheet.Copy
Dim MyName As String

With ActiveSheet.Select
MyName = strDate & "-" & Range("B3") & "-" & Range("D9")
Path = "F:\Commun\cafétéria\COMMANDE\DUBORT\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyName
Application.DisplayAlerts = True
End With

' preping mail
Dim OlApp As Object
Path = "F:\Commun\cafétéria\COMMANDE\DUBORT\"
Salesman = Split(ActiveWorkbook.Name, ".")(0)
If i > 1 Then PDF_File = Left(PDF_File, i - 1)
PDF_File = Path & Salesman & ".pdf"

With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

Set OlApp = CreateObject("Outlook.Application")

With OlApp.CreateItem(0)
.Display
.Subject = "Une commande de la cafétéria" & " " & Range("B3") & "-" & Range("D9") & "-" & strDate
.To = "A@B.ca"
.htmlbody = "<html><body><p>Bonjour,</p><p>Voici une commande de la cafétéria.</p>" _
& "<p>À commander avant midi svp.</p>" _
& "<p> Important avant midi !!!.</p><html><body>" & .htmlbody
.Attachments.Add PDF_File
.Display
Set OlApp = Nothing
End With

ActiveWorkbook.Close savechanges:=True

'erase sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

'erase cell in origin sheet
Sheets("Dubort Et Rainville").Select
Range("C14:C48").Select
Selection.ClearContents
Range("C51:C70").Select
Selection.ClearContents
Range("C73:C103").Select
Selection.ClearContents
Range("C106:C131").Select
Selection.ClearContents
Range("C134:C144").Select
Selection.ClearContents
Range("C147:C176").Select
Selection.ClearContents
Range("C179:C188").Select
Selection.ClearContents
Range("C191:C209").Select
Selection.ClearContents
Range("C212:C240").Select
Selection.ClearContents
Range("C243:C276").Select
Selection.ClearContents
Range("C279:C292").Select
Selection.ClearContents
Range("C295:C327").Select
Selection.ClearContents
Range("C330:C374").Select
Selection.ClearContents
Range("C377:C384").Select
Selection.ClearContents
Range("C387:C404").Select
Selection.ClearContents
Range("C407:C417").Select
Selection.ClearContents
Range("C420:C436").Select
Selection.ClearContents
Range("C439:C478").Select
Selection.ClearContents
Range("C481:C515").Select
Selection.ClearContents
Range("C518:C523").Select
Selection.ClearContents
Range("C526:C543").Select
Selection.ClearContents
Range("C546:C581").Select
Selection.ClearContents
Range("C584:C618").Select
Selection.ClearContents
Range("C621:C655").Select
Selection.ClearContents
Range("C658:C674").Select
Selection.ClearContents
Range("C677:C680").Select
Selection.ClearContents
Range("D9").Select

ActiveSheet.Protect Password:="1234", _
DrawingObjects:=True, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions

End Sub
 

Attachments

  • header.JPG
    header.JPG
    116.9 KB · Views: 12
  • line.JPG
    line.JPG
    235.7 KB · Views: 12

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
If you haven't come up with a solution yet maybe this will help.

You could put those ranges of C cells into a single range like this
VBA Code:
With ActiveSheet
    ' the ranges of C cells that could have data
    Set workRng = Union(.Range("C14:C48"), .Range("C51:C70"), .Range("C73:C103"), .Range("C106:C131"), _
                    .Range("C134:C144"), .Range("C147:C176"), .Range("C179:C188"), .Range("C191:C209"), _
                    .Range("C212:C240"), .Range("C243:C276"), .Range("C279:C292"), .Range("C295:C327"), _
                    .Range("C330:C374"), .Range("C377:C384"), .Range("C387:C404"), .Range("C407:C417"), _
                    .Range("C420:C436"), .Range("C439:C478"), .Range("C481:C515"), .Range("C518:C523"), _
                    .Range("C526:C543"), .Range("C546:C581"), .Range("C584:C618"), .Range("C621:C655"), _
                    .Range("C658:C674"), .Range("C677:C680"))
End With

and use this to clear those cells
VBA Code:
    workRng.ClearContents
or this to delete rows where they are blank
VBA Code:
    workRng.SpecialCells(xlBlanks).EntireRow.Delete
 
Upvote 0

Forum statistics

Threads
1,223,889
Messages
6,175,223
Members
452,620
Latest member
dsubash

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