Hi all,
So I have a Button that, when clicked, runs VBA codes that first deletes empty rows, then emails my company a copy of the sheet, and then allows the user to print the sheet. However, what I need is an additional code that resets all the information on the excel document to its original sheet.
Basically, I have a list of accounts on a master sheet that are sent out to a customer for verification. In the workbook, there is a hidden "Sheet2" tab. Sheet2, is basically a mirror image of the master accounts with some added verbiage. Once the customer is done verifying the accounts on the master sheet, it hits a submit button that runs the actions i described above. Since the accounts that will populate sheet two vary from 1,000 to 5 accounts, depending on the customer, I have included a VBA that deletes rows from the bottom so it can print properly.
After the actions are through, I need to re-add the rows ON SHEET 2 (not the master sheet) that were deleted (formulas and formatting).
If anyone has any ideas, please let me know!
I have included the VBA below.
Thank you!
Sub Button1_Click()
Sheets("Sheet2").Range("B1").Value = Now()
'Below statement will print 3 copy of the Sheet1 from Page 2 to Page no: 3
Worksheets("Sheet2").PrintOut From:=1, To:=3, Copies:=1, Preview:=True
End Sub
Sub DeleteRows()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With Sheets("Sheet2")
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = 7
Lastrow = 204
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the A column in this example
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
If .Value = "ron" Then .EntireRow.Delete
'This will delete each row with the Value "ron"
'in Column A, case sensitive.
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
Sub Mail_Every_Worksheet()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
For Each sh In ThisWorkbook.Worksheets
If sh.Range("A2").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = sh.Range("A2").Value
.CC = ""
.BCC = ""
.Subject = "FUSF recerticification"
.Body = "Verified Accounts"
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With
Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Sub RunAll()
Application.ScreenUpdating = False
Sheets("Sheet2").Visible = True
Call DeleteRows
Call Print_All
Call Mail_Every_Worksheet
Sheets("Sheet2").Visible = False
Application.ScreenUpdating = True
End Sub
Bookmarks