Free Microsoft Excel 2013 Quick Reference

Cell value in header or footer Results

is it possible to put the contents/value of a cell in the header?

--
I will Excel at Excel!

Three questions:

1) In Excel (i.e. without VBA), how can I reference a cell value, such as Cell C5, from the worksheet area for use in a header or footer?

2) When I do a reference like that in VBA using a command button and code like:

With ActiveSheet.PageSetup
...
.CenterHeader = Range("C5").Value
...
End With

when I click the command button, the screen flickers, as if it's painting each statement of the WITH clause sequentially. What causes that?

3) ActiveWindow.SelectedSheets.PrintPreview
will get me into PrintPreview. What is the VBA equivalent of clicking the CLOSE button when you are already in PrintPreview?

TIA,

Far Farley
The Professional Network
Atlanta, Georgia

I hope there is a way to represent a cell value in the header or footer of an
Excel sheet. I'm using Microsoft Excel 2003 SP3.

Hi, I have seen some posts that are similar, but no one seems to have the problem that I am having. I will post my macro in this, for anyone that is interested.

My users get a csv file every month, and we have to clean it up. This macro does that.

My last issues are this:

1) having the spreadsheet create page breaks whenever the value in column B changes. Below is just that code.

col = 2 
LastRw = ActiveSheet.UsedRange.Rows.Count 
For X = 2 To LastRw 
If Cells(X, col) <> Cells(X - 1, col) And Cells(X, col) <> Range("B1") Then 
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(X, col) 
End If 
Next

The problem that I am having, is that my first page is just row 1. I have row 1 repeat at the top of every page. It does make sense in the code that this value changes, so it makes a page break. Can anyone help me to adjust my code so that it will ignore the first row when it makes the page breaks? The value of B1 will always be the same, so my thought is to make that "If ...Then" statement include something that says not if Cells(X, col) = B1. Make sense?

Second issue:

2) I want to take the value in column B, as it will be the same for any given page due to the above page breaks, and put that in the footer.

I have commented out the code that I was having fun with trying. The idea is that column B is a box number, and I want to have that box number in the footer, so that it is easy to see on the sheet. Here is my page setup code for headers and footers.

As I said, I commented out the right footer where I would put this code. Any help would be great.

  With ActiveSheet.PageSetup 
      .CenterHeader = "Our Form" 
      .LeftFooter = Date 
      .CenterFooter = "Signature __________________________________" 
   ' this is where I want the value -->   .RightFooter = "Box Number: " & Column("B:B").Value 
    End With
From the posts I have been reading, you cannot use formulas in the footer. I wish this was not true. My idea was that many formulas or functions could work here. Because I break the page on the value in this column any function that finds the value of any B column cell in the page could be used in this right footer. Like first or last would work.

Anyway, if I cannot get this second part, I can still deploy the macro. I just need to fix the first part.

For anyone who is interested, I will post my code in a reply. It is too long as one whole post.

Thanks!

I'm trying to create a button attached to a Macro that will print a constant
range of cells for a header, and several variable ranges depending on the
value of a particular cell in each variable range, and a selection of a
constant range for a footer.

PROBLEM, I have read the VBA for dummies and well, its not the right book or
I'm REALLY a dummy cause I cant figure out what I should be doing.

Any thoughts on the code I need? Or point me in the right direction??

Thanks,
John

Hi, I have seen some posts that are similar, but no one seems to have
the problem that I am having. I will post my macro in this, for anyone
that is interested.

My users get a csv file every month, and we have to clean it up. This
macro does that.

My last issues are this:

1) having the spreadsheet create page breaks whenever the value in
column B changes. Below is just that code.

Code:
col = 2
LastRw = ActiveSheet.UsedRange.Rows.Count
For X = 2 To LastRw
If Cells(X, col) <> Cells(X - 1, col) And Cells(X, col) <> Range("B1")
Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(X, col)
End If
Next
----------------------------------

The problem that I am having, is that my first page is just row 1. I
have row 1 repeat at the top of every page. It does make sense in the
code that this value changes, so it makes a page break. Can anyone help
me to adjust my code so that it will ignore the first row when it makes
the page breaks? The value of B1 will always be the same, so my thought
is to make that "If ...Then" statement include something that says not
if Cells(X, col) = B1. Make sense?

Second issue:

2) I want to take the value in column B, as it will be the same for any
given page due to the above page breaks, and put that in the footer.

I have commented out the code that I was having fun with trying. The
idea is that column B is a box number, and I want to have that box
number in the footer, so that it is easy to see on the sheet. Here is
my page setup code for headers and footers.

As I said, I commented out the right footer where I would put this
code. Any help would be great.

Code:
With ActiveSheet.PageSetup
.CenterHeader = "Our Form"
.LeftFooter = Date
.CenterFooter = "Signature __________________________________"
' this is where I want the value --> .RightFooter = "Box Number: "
& Column("B:B").Value
End With
---------------------------

>From the posts I have been reading, you cannot use formulas in the
footer. I wish this was not true. My idea was that many formulas or
functions could work here. Because I break the page on the value in
this column any function that finds the value of any B column cell in
the page could be used in this right footer. Like first or last would
work.

Anyway, if I cannot get this second part, I can still deploy the macro.
I just need to fix the first part.

For anyone who is interested, here is my entire messy code. I started
off with what we had, recorded portions to do more, and added bits and
pieces together.
Be warned that I am not advanced at Excel macros, so it is a messy one.

It is not organized at all, but it works!

Code:
Sub MyCsvConvert()

Application.ScreenUpdating = False
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "Date " & Chr(10) & "Entered"
With ActiveCell.Characters(Start:=1, Length:=13).Font
End With
Range("A1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "SKP " & Chr(10) & "Box #"
Columns("B:B").Select
Selection.ColumnWidth = 9.2
Range("B1").Select
With Selection
.HorizontalAlignment = xlRight
End With
Columns("C:G").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "Dept. #"
Range("C1").Select
With Selection
.HorizontalAlignment = xlRight
End With
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "Record " & Chr(10) & "Code"
With ActiveCell.Characters(Start:=1, Length:=12).Font
End With
Range("D1").Select
With Selection
.HorizontalAlignment = xlRight
End With
Columns("E:G").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.ColumnWidth = 9.17
Range("E1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
ActiveCell.FormulaR1C1 = "Destruction " & Chr(10) & "Date"
With ActiveCell.Characters(Start:=1, Length:=17).Font
End With
Range("F1").Select
Columns("F:F").ColumnWidth = 9.5
Columns("F:G").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Columns("H:I").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.ColumnWidth = 21.5
'Columns("I:I").ColumnWidth = 21.5
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
'ActiveWindow.SmallScroll ToRight:=6
Columns("I:J").Select
Selection.ColumnWidth = 21.5
'Columns("K:K").ColumnWidth = 21.5
Columns("K:M").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=-1
Range("C1").Select
ActiveCell.FormulaR1C1 = "Depart #"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Atty Number"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Client Number"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Matter Number"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Client Name"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Matter/File Descrip"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Real/Est Collect Numer"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Closing Date"
Columns("I:I").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("H:H").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("H:H").ColumnWidth = 34.57
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F1").Select
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight,
RegionIndex:=1
ActiveWindow.LargeScroll ToRight:=-1
Cells.Select
Selection.Copy
Workbooks.Add Template:="Workbook"
ActiveSheet.Paste
ActiveSheet.PageSetup.Orientation = xlLandscape
With Worksheets(1).PageSetup
.LeftMargin = Application.InchesToPoints(0.35)
.RightMargin = Application.InchesToPoints(0.35)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintGridlines = True
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.CenterHeader = "Our Form"
.LeftFooter = Date
.CenterFooter = "Signature __________________________________"
' this is where I want the value --> .RightFooter = "Box Number: "
& Column("B:B").Value
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 9.29
Columns("F:F").ColumnWidth = 7
Columns("F:F").ColumnWidth = 6.29
Columns("F:F").ColumnWidth = 5.57
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 9.43
Selection.ColumnWidth = 7.71
Columns("G:G").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 9.43
Selection.ColumnWidth = 8
Selection.ColumnWidth = 7.29
Columns("I:I").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 15.57
Selection.ColumnWidth = 12.71
Selection.ColumnWidth = 11
Columns("J:J").ColumnWidth = 25.86
Columns("J:J").ColumnWidth = 28.29
Range("H2").Select
ActiveCell.FormulaR1C1 = "M &amp; T MORTGAGE CORPORATION"
With ActiveCell.Characters(Start:=1, Length:=30).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.Replace What:="&amp;", Replacement:="&", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False
Rows("1:1").Select
Selection.Font.Bold = True
Range("D1").Select
Columns("D:D").ColumnWidth = 7.71
Columns("E:E").ColumnWidth = 7.43
Range("I1").Select
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Columns("B:B").Select
Range("A1:J81").sort Key1:=Range("B2"), Order1:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
col = 2
LastRw = ActiveSheet.UsedRange.Rows.Count
For X = 2 To LastRw
If Cells(X, col) <> Cells(X - 1, col) And Cells(X, col) <> Range("B1")
Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(X, col)
End If
Next
If Not ActiveWorkbook.Saved Then
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If

End Sub
---------------------------------

Thanks!

Hi all, i'm pretty new to Excell in the workplace and would really love it if you lot could help me with this difficult (TO ME) macro i'm struggling with.

I'm trying to finish off this macro, or mod it so that i get the page number, tab number, a cell reference in the respective headers and footers as explained in the macro below. only thing is i don't really want the tab label, cell reference (rev number/date) on the first page ie the first tab called coversheet.

The text in bold italics is my attempt at this but i'm stuck at it.

Please guys i'd appreciate the help, who knows i might actaully get good at this one day!

Cheers, Tom

MACRO....;

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Dim WS As Worksheet
For Each WS In Worksheets
'REV number and date in RHS footer on all except cover sheet
If Not WS.Name = "Cover sheet" Then
WS.PageSetup.RightFooter = Worksheets("Cover sheet").Range("B55").Value & _
Worksheets("Cover sheet").Range("L35").Value & _
Worksheets("Cover sheet").Range("B56").Value & _
Worksheets("Cover sheet").Range("L35").Value & _
Worksheets("Cover sheet").Range("A55").Value & _
Worksheets("Cover sheet").Range("L35").Value & _
Worksheets("Cover sheet").Range("A56").Value
'Document number in LHS header size 14
WS.PageSetup.LeftHeader = Worksheets("Cover sheet").Range("A10").Value
'Tab name in RHS Header BOLD fontsize 20
WS.PageSetup.RightHeader = "&B&25&A"
'Page number in Central footer BOLD size 14
WS.PageSetup.CenterFooter = "&B&14&P"

End If
Next WS
End Sub

I know in WORD you can insert a field into your header or footer that basically is only changed IF the document was actually changed ( in other words I have to actually make a change and save the document ).

How is this done in EXCEL.

What I want is that a CELL ( Say A1 ) is updated with a date value only if the file is changed and saved

Alright so what I'm trying to do is standardize a workbook. I want to reference a cell in sheet 21. The way the formula is currently set up, it looks at cell A100 in the current active sheet. I want the macro to reference cell C3 in sheet 21 or my input sheet.

Here's the code


	VB:
	
 CompanyHeaderChangeHorizontalSheet() 
     ' inserts the same header/footer in all worksheets
    Dim ws As Worksheet 
    Application.ScreenUpdating = False 
    For Each ws In ActiveWorkbook.Worksheets 
        Application.StatusBar = "Changing header/footer in " & ws.Name 
        With ws.PageSetup 
            .CenterHeader = _ 
            "&""Arial,Regular""&18&K000080                                                                                   
     &U&K000080" & Range("a100").Value 
        End With 
    Next ws 
    Set ws = Nothing 
    Application.StatusBar = False 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Thanks for your help!

Hi Gurus!

I have a sheet used to process sales orders - about 500 orders per month x ~1.5Mb each. I want to save them as smaller files.

The sheets to save are full of vlookups linked to external sheets and tabs, other formulas, and macros - most of which do not need saving when the sales order is filed. There are lots of merged cells too.

I must save:
1. Cell values
2. Cell formats incl merged cells, borders, colour, font etc.
3. The row and column sizes
4. Print set ups - print area, margins, page setup, header footer etc - (Everything needed to reprint to same as original)

I think I need a "File save as" style Macro which opens a dialogue box for the user to nominate the destination folder (& allows the user to browse for it), and a new file name.

The original file name is "Job Sheet - Omlaw.xls"
The tab/sheet to save is "Front Sheet"
(There are two other tabs - neither of which need saving.)

All cells to be changed to "locked".
The sheet must be password protected in Excel. User to enter it - or not.
The saved file should be "write protected" if possible?

What would you recommend?

Ben

I got a tuff one that i hope one of you can help me out with.

I have made a macro for the purpose of making a workbook ready for distribution. My macro contain several features.
1. It prompts the user to save workbook as a new file
2. It deletes tabs that are not blue (colorindex=37)
3. It makes a PasteSpecial Paste:=xlPasteValues to get rid of all fomulas
4. It deletes rows and columns outside a user defined named range "Print_area" to ger rid of not relevant info and to relocate Print_area to top left corner.
5. It keeps page formatting, page footer, page header etc.

My problem is that the code below actually work only under certain conditions, and I would like it to be used anywhere.
If you make a new workbook, paste in the code it will work.
If you have a large workbook with a lot of data, tabs, formulas, formatting etc. you very much risk that it will fail returning : Run-time error '1004' Application-defined or object defined error.

I read a bit about what may could cause the problem here:
http://support.microsoft.com/kb/210684

I cant brag about understanding much about it though

Sub Get_wb_ready_for_distribution()

Dim x
Dim ws As Worksheet
Dim t
Dim lastRK
Dim lastKOL
Dim ws2 As Worksheet

'Promts the user to save the workbook with a new name before manipulating data.
Application.Dialogs(xlDialogSaveAs).Show
If Not ThisWorkbook.Saved Then Result = MsgBox("You didn't save the workbook. This function will now exit!")

If Result = vbOK Then
Exit Sub
End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
With ws
.Select

If ActiveSheet.Tab.ColorIndex = 37 Then

If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect Password:=""
End If

Range("Print_area").Select
Selection.Copy

'Copies sheet and pastes values only
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Removes columns to the left of Print_area and rows above
On Error Resume Next
Rows("1:" & Range("print_area").Row - 1).EntireRow.Delete
If Range("print_area").Column - 1 >= 1 Then
For t = Range("print_area").Column - 1 To 1 Step -1
Columns(t).EntireColumn.Delete
Next
End If

lastRK = Range("A1").SpecialCells(xlLastCell).Row
lastKOL = Range("A1").SpecialCells(xlLastCell).Column
Rows(Range("print_area").Rows.Count + 1 & ":" & lastRK).EntireRow.Delete

Range("print_area").Offset(0, Range("print_area").Columns.Count).Resize(1, lastKOL).EntireColumn.Delete
Else:
End If
On Error Resume Next

End With

Cells("A1").Select

Next ws

For Each ws2 In ActiveWorkbook.Worksheets
With ws2
.Select

If ActiveSheet.Tab.ColorIndex 37 Then
ActiveSheet.Delete
End If
On Error Resume Next

End With
Next ws2

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Hi,
got the following script which will generate a load of draft emails, from a list i have.
However i want some parts of the emails i create to be in bold (templateHeader for example)

anyone know how to do this?

Code:
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub MoversReports()

' Macro to mail out Movers reports for reviews by line managers

' Setup an error handler to report any errors during mail sending
'On Error GoTo SendMailError

' Setup key variables
Dim objNotesSession As Object
Dim NotesOpen As Long
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesStyle As Object
Dim objNotesField As Object
Dim dataSheet, reportSheet, moversSheet
Dim EMailCCTo, EMailBCCTo, EMailSendTo, templateSubject, templateHeader, templateFooter, templateAttach, currRow, reportRow,
reqRow
Dim reportDate, sender, userGBID, userName, oldLineMgr, newLineMgr, userEmail, oldLineMgrEmail, newLineMgrEmail,
transferDate, foundPerm, endedPerm, tmpString, linesCnt, saveSendFlag
Dim nonPermUsers, numNonPermUsers, reportSheetName, reportSheetRow

'Check if Lotus Notes is open or not.
NotesOpen = FindWindow("NOTES", vbNullString)

If NotesOpen = 0 Then
   MsgBox "Notes must be open to run this script!", vbExclamation
   Exit Sub
End If

' Note the worksheets we are using
Set dataSheet = ActiveWorkbook.Sheets("DATA")
Set reportSheet = ActiveWorkbook.Sheets("reason")
Set moversSheet = ActiveWorkbook.Sheets("leavers")

' Extract the send/save flag
saveSendFlag = ActiveWorkbook.Sheets("Instructions").Cells(5, 7).Value

' Extract the templates for the subject, header and footer, cc, bcc
'EMailBCCTo = ""
'EMailCCTo = dataSheet.Cells(5, 12).Value
templateSubject = dataSheet.Cells(5, 13).Value
templateHeader = dataSheet.Cells(5, 14).Value
templateFooter = dataSheet.Cells(5, 15).Value
templateAttach = dataSheet.Cells(5, 16).Value
sender = dataSheet.Cells(5, 17).Value

' Create a blank string to hold all the GBIDs of users who have no permissions within the list
nonPermUsers = ""
numNonPermUsers = 0

' Pop up the status dialog to notify user of progress
Dim statusDialog As UserForm1
Set statusDialog = New UserForm1

' Initialise the captions
statusDialog.Label2.Caption = "1"

' Make the form visible
statusDialog.Show

' Iterate through all user names in the movers list
currRow = 4

While moversSheet.Cells(currRow, 1).Value  ""
  
    ' Update progress dialog
    statusDialog.Label2.Caption = CStr(currRow - 3)
    statusDialog.Repaint
    
    ' extract details from the movers row
    userGBID = UCase(Trim(moversSheet.Cells(currRow, 1).Value))
    userName = moversSheet.Cells(currRow, 2).Value & " " & moversSheet.Cells(currRow, 3).Value
        
    userEmail = moversSheet.Cells(currRow, 4).Value

    ' If any of the emails are blank, just replace with that users name
    If userEmail = "" Then userEmail = userName
            
    ' Iterate through all the permissions provided to check the user has any relevant permissions, as if not then nothing to
send
    reqRow = 4
    
    ' Mult-page permission sheets coding
    reportSheetRow = 6
    reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
    Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)

    foundPerm = False
    endedPerm = False
    While Not foundPerm And Not endedPerm
    
        ' Check if this is the end row for a sheet and if so, roll onto the next sheet
        If reportSheet.Cells(reqRow, 1).Value = "" Then
        
            reportSheetRow = reportSheetRow + 1
            reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
            
            If reportSheetName = "" Or reportSheetName = "END OF LIST" Then
                endedPerm = True
            Else
            
                ' Restart on next page
                Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)
                reqRow = 4
                
            End If
        Else
        
            ' Note if find any permissions entries
          '  UCase (Trim(reportSheet.Cells(reqRow, 1).Select))
            If UCase(Trim(reportSheet.Cells(reqRow, 1).Value)) = userGBID Then
                foundPerm = True
            End If
        
            reqRow = reqRow + 1
        End If
    Wend
        
    ' If there are any permissions noted then connect to lotus and start building the email, else add to non perms list
    If foundPerm = False Then
    
        numNonPermUsers = numNonPermUsers + 1
    
        ' Add the user GBID into list for later display as no email will be sent
        If nonPermUsers = "" Then
            nonPermUsers = userGBID
        Else
            nonPermUsers = nonPermUsers & ","
            
            ' Add a new line on every 5th one to fill out the dialog box sensibly
            If numNonPermUsers Mod 5 = 0 Then
                nonPermUsers = nonPermUsers & Chr(10)
            End If
            nonPermUsers = nonPermUsers & userGBID
        End If
        
    Else
    
        ' Setup all the core email fields and header
        EMailSendTo = userEmail '' Required - Send to address
        
        ' Establish Connection to Notes
        Set objNotesSession = CreateObject("Notes.NotesSession")
        
        ' Establish Connection to Mail File
        Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
        
        ' Open Mail
        objNotesMailFile.OPENMAIL
        
        ' Create New Memo
        Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
        
        ' Create 'Subject Field' - replace template fields with correct values
        tmpString = Replace(templateSubject, "", userName)
        tmpString = Replace(tmpString, "", userGBID)
        Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", tmpString)
        
        ' Create 'Send To' Field
        Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
        
       ' Note the sender as configured
        Set objNotesField = objNotesDocument.APPENDITEMVALUE("From", sender)
        objNotesDocument.Principal = sender
        
        ' Create 'Body' of memo
        Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
        Set objNotesStyle = objNotesSession.CreateRichTextStyle
                      
        ' Add header
        tmpString = Replace(templateHeader, "", userName)
        tmpString = Replace(tmpString, "", userGBID)
        
        With objNotesField
            .appendtext tmpString
         End With
        
        ' Iterate through the permissions list report and generate lines for each permission
        reportRow = 4
        linesCnt = 0
        
        ' Mult-page permission sheets coding
        reportSheetRow = 6
        reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
        Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)

        endedPerm = False
        
        While Not endedPerm
        
            ' Check if this is the end row for a sheet and if so, roll onto the next sheet
            If reportSheet.Cells(reportRow, 1).Value = "" Then
            
                reportSheetRow = reportSheetRow + 1
                reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
                
                If reportSheetName = "" Or reportSheetName = "END OF LIST" Then
                    endedPerm = True
                Else
                    ' Restart on next page
                    Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)
                    reportRow = 4
                End If
    
            Else
        
                ' Where a match is found, add a line to the memo
                If UCase(Trim(reportSheet.Cells(reportRow, 1).Value)) = userGBID Then
                    
                    ' Increment count of retrievals listed
                    linesCnt = linesCnt + 1
                    
                    ' Build text for line - App name - (account id) (if not same as GBID) permissions
                    tmpString = reportSheet.Cells(reportRow, 2).Value

                    With objNotesField
                        .appendtext tmpString
                        .ADDNEWLINE 1
                        
                    End With
                
                End If
                
                reportRow = reportRow + 1
                
            End If
        Wend
                 
        ' Add footer
        tmpString = Replace(templateFooter, "", userName)
        tmpString = Replace(tmpString, "", userGBID)
        With objNotesField
            .appendtext tmpString
        End With
        
        ' Depending on what the flag is, either send or save to drafts
        If saveSendFlag = 1 Then
        
            ' Send the email & close down the connection with Lotus
            objNotesDocument.SaveMessageOnSend = True
            objNotesDocument.Send (0)
        
        Else
        
            ' Save the email as draft & close down the connection with Lotus
            Call objNotesDocument.Save(True, False)
            objNotesDocument.RemoveItem ("DeliveredDate")
            Call objNotesDocument.Save(True, False)
        
        End If
        
        ' Release storage
        Set objNotesSession = Nothing
        Set bjNotesSession = Nothing
        Set objNotesMailFile = Nothing
        Set objNotesDocument = Nothing
        Set objNotesField = Nothing
    
    End If
    
    ' Next mover
    currRow = currRow + 1

Wend

' Hide the status dialog and delete it (remove reference to it)
statusDialog.Hide

' After processed all the movers, notify the user if any movers had no permissions and no emails sent for them
If nonPermUsers  "" Then

    
    Dim finalDialog As UserForm2
    Set finalDialog = New UserForm2
    
    ' Set the text on the form
    finalDialog.TextBox1.Text = nonPermUsers
    
    ' Make the form visible
    finalDialog.Show
    
End If

Exit Sub

' Error handling code designed to warn if any errors occurred during attempt to send email
SendMailError:
Msg = "Is Lotus Running? - Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

End Sub


Hi

I want to place several images "behind" the cells or their text values - so if you imagine something like several different ID Cards for example, and I want to generate all the text for these using formulas and such, and place the text over specifc areas of the card images.

I can try to create a composite image of the various things I want and put them on a blank sheet adding it as a header/footer, but aligning everything, or making changes to the images make this a laborious task and not easily changeable.

Is there a simple way of adding images to an Excel (2007) worksheet and then moving it "behind" the cell contents (so the pictures do not mask the cell contents)?

Many thanks in advance

I have tried for two weeks before finally joining the forum out of desperation; can someone here please help me?

I am trying to populate an invoice from a list of items in another sheet

I have two sheets in one workbook, Sheet1 (Invoice) and sheet2 (Database).
Both sheets have 3 columns, B, C & K with headings (quantity-Description-cost).
Sheet 1 is a list of 2000 items; each item can be selected by entering a quantity.

I would like to use a macro that copies the items selected in sheet2 to the first blank row (counting from the top down B14:K2000) to sheet 1.
Only the selected items would be copied and placed sequentially in sheet1, no blank cells or rows would be copied.

I have attached a workbook with two macros, everything works just fine if you hit the 'copy rows' macro but it deletes the formulas in the total column, so I would prefer to use the 'copy cells' macro but the items are being copied with blank rows and it will only populate one page where the 'copy rows macro' populates more than one page with header and footer.

Code below if it helps.

Thanks for looking, Mayweed.

Cell macro
Sub CopyOneAreaValues()
Sheets("Database").Select
ActiveSheet.Unprotect
    Dim sourceRange As Range
    Dim destrange As Range
    Dim Lr As Long
    Lr = LastRow(Sheets("Database")) + 1
    Set sourceRange = Sheets("Database").Range("B14:K60")
    With sourceRange
ActiveSheet.Protect
Sheets("Invoice").Select
ActiveSheet.Unprotect
        Set destrange = Sheets("Invoice").Range("B" & Lr). _
        Resize(.Rows.Count, .Columns.Count)
    End With
    destrange.Value = sourceRange.Value
ActiveSheet.Protect
End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("B14"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function Lastcol(sh As Worksheet)
    On Error Resume Next
    Lastcol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("B14"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function
Row macro that adds totals and formats if the page is full

Sub Populate()
Sheets("Database").Select
'. Conditional test
    Dim rngTest As Range
    '. Set cell T13
    Set rngTest = Sheet3.Range("V13")
    '. Look at V13
    Select Case rngTest.Value
        Case Is > 4:
        '. If V13 > than 35(one full invoice page) (This is set to >4 for testing purposes only) do the following

ActiveSheet.Unprotect

'. Add total formulas to bottom of Database sheet
    Range("L2002").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(R[-1988]C:R[-2]C)>0,SUM(R[-1988]C:R[-2]C),"""")"
    
    Range("L2003").Select
    ActiveCell.FormulaR1C1 = _
       
"=IF(AND(R[1]C<>"""",R2002C12<>""""),ROUND(R[1]C*R2002C12,2),"""")"
        
            Range("L2004").Select
    ActiveCell.FormulaR1C1 = "0.175"
        With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    
        Range("L2005").Select
    ActiveCell.FormulaR1C1 =
"=IF(R[-3]C<>"""",SUM(R[-3]C:R[-2]C),"""")"
    
  '. Add text and format cells
        Range("K2002").Select
    ActiveCell.FormulaR1C1 = "Subtotal"
    Selection.Font.Bold = True
    Range("K2003").Select
    ActiveCell.FormulaR1C1 = "Vat 17.5%"
    Range("K2005").Select
    ActiveCell.FormulaR1C1 = "Total"
    Selection.Font.Bold = True
    
    ' Add 1 for each totals row to qualify as a product and get cut/pasted
    Range("B2001").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B2002").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B2003").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B2004").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B2005").Select
    ActiveCell.FormulaR1C1 = "1"
    
    ActiveSheet.Protect

' Format Invoice extended total cells.

Sheets("Invoice").Select
ActiveSheet.Unprotect
    Range("B48:L48").Select
    Selection.AutoFill Destination:=Range("B48:L53"), Type:=xlFillDefault
    Range("B48:L53").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.14996795556505
        .Weight = xlHairline
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.14996795556505
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B53:L53").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.149937437055574
        .Weight = xlHairline
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.149937437055574
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.149937437055574
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.149937437055574
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

'. Populate Invoice

Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Database")
Set Destination = Worksheets("Invoice")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <> "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A14")
Range("B14").Select
End If
End With
    
    Case Else:

'. Or just forget the above and populate Invoice to fill one page only
Sheets("Invoice").Select
ActiveSheet.Unprotect

Set Source = Worksheets("Database")
Set Destination = Worksheets("Invoice")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <> "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A14")
End If
   End With
ActiveSheet.Protect
End Select
End Sub


I'm setting up a sheet that has a macro looking at a range of cells with equations in them and if I go in and update the data in one of those cells, then it goes and copies the new data into the cell the first cell was looking at and then restores the first cells equation.

I was sitting here trying to figure out how my guys would break it... so I tried to dump data in more than one cell and found that when the macro breaks in the middle before ScreenUpdating is reactivated that I can't get back to my screen... it just gives me the header and footer, but doesn't show any cells... is this supposed to happen? I realize that's what I'm telling it to do when the code doesn't finish, but I'd have assumed that MS would have caught something this simple. I'm guessing someone else has run into this? ...I'm thinking I'll just comment the ScreenUpdating out altogether.

Another issue I'm finding is that if I for some reason happen to overwrite a main cell with equations in it and try to just copy the adjoining row and paste it over to make the correction somehow Excel is disabling macros! ..and I can't get them restarted without closing the sheet and reopening it. Anyone ever seen this??? ...is there fix or am I just hosed?

The code I'm using is... (another big Thank You! to JBeaucaire!)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, MyVal As Variant
Application.ScreenUpdating = False
    For Each cell In Target
        If Not Intersect(cell, Range("D3:L6")) Is Nothing Then
            MyVal = cell
            Application.EnableEvents = False
                Application.Undo
                Range("D19") = MyVal
                Range(Target.Address).Precedents.Value = MyVal
            Application.EnableEvents = True
        End If
    Next cell
Range("A1").Select
Application.ScreenUpdating = True



End Sub
Any insight to reactivating the macros would be much appreciated!
Thanks!
Chad

I've tried to reasearch this on here and many other places (including reading some of John Walkenbach's Excel 2007: Power Programming with VBA). I guess there is somehing that is still not clicking yet, and so I am turning to the the wonderful people of this forum for some assistance. This is a little more complex than the title suggests but I did not know how to condense it any more while remaining coherent.

I have attached a small sample worksheet as well as a verification worksheet that I will explain below:

First, a few things when looking at the sample file:
In column A, a value of "8" signifies the beginning of a data type. In Column E on that same row is a 2-digit number defining the data type. Then, every row following a row w/ an "8" in Column A will have a "4" in Column A, signifying that the cells in that row are the data. The end of the data for that data type is signified by a "9" in Column A. Then, the next row will start a new data type that has completely different data/ different # of columns, etc.

It's similar to html code, in that you have the wrappers at the beginning and end of what you're appling it to (ex: [ QUOTE] quoted text goes here [ /QUOTE]). The row starting with an "8" in C1 being the "[ QUOTE]", the rows starting with a "4" in C1 being the quoted text, and the row with a "9" in C1 being the "[ /QUOTE]" (Or you can think of the 8 and 9 as the header/footer of each data type within the worksheet)

In short, you would read the attached sample worksheet as the "8" in R3C1 indicates the beginning of type "11" data(R3C5). The "9" in R6C1 indicates the end of type 11 data. The "8" in R7C1 signifies the beginning of type "05" data (R7C5). This is the data type I am interested in.

However, the beginning of type 05 data might start on row 82, or it might start on row 257. It will change every month (The sample file represents data from one month.) Additionally, the desired range will vary from month to month as well.

I am trying to create a macro that will essentially do this:
If a cell in Column A has valueof "8" AND Column E in the same row has a value of "05", then copy the cells in Column B starting on the next row and continue until there is a value of "9" in Column A (or, alternatively, until it reaches a row where Column A does not have a value of "4").

I would then like to take the copied cells, loop each of them through the Luhn (MOD-10) checksum on the another workbook(attached), and then copy the values which pass the validation onto a new worksheet.

Additionally, I need to use RTRIM on the cells taken from Column B to remove the 3 spaces, and also filter out duplicate values before running them through the validation. I dont know if this can all be done in one swoop or if I need to break this into two parts ( 1: finding and selecting the variable range in Column B and pasting to a new worksheet or workbook. Then, RTRIM and filter them, (manually if needed for simplicity). 2: Loop trimmed/filtered cells through verification check and copy all the values that pass to a new worksheet).

Where I am getting caught up is in the fact that I dont know in which row the column will start, nor how many rows will be in the range. The files are monthly credit card transactions, so as employees are hired or leave from month to month, the number of unique values will change, in addition to the number of transactions from month to month. Also, I'm getting thrown off by the fact that everything is formatted as text (the files come to me originally as tab delimited TXT files).

Any assistance would be much appreciated.

This is a followup to a post I had marked as solved, and it's really not. Below are two different Email routines I've tried, both based on macros by Ron DeBruin, neither of which fully satisfy my need.

One routine creates a copy of a spreadsheet and mails it. The problem with that is that my source spreadsheet has cells containing 255 characters or more, and Excel truncates the cells after 255 characters, so all of the data isn't going into the new spreadsheet.

The other creates a new spreadsheet, copies the data from my old spreadsheet, and pastes it into the new spreadsheet. Problem with that is the new spreadsheet doesn't have my footer or headers and isn't formatted to print correctly.

I need to either find a way to get past the 255 problem, or find a way to copy a properly set up spreadsheet and paste my data into it. Any help would be appreciated.

My code is below:

This one copies the spreadsheet and mails it
Sub Mail_Array()

'Works, but truncates cells with 255 or more characters

'Working in 2000-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim TheActiveWindow As Window
    Dim TempWindow As Window
    Dim olInBox As Object
    Dim olSent As Object


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheets to a new workbook
    'We add a temporary Window to avoid the Copy problem
    'if there is a List or Table in one of the sheets and
    'if the sheets are grouped

    With Sourcewb
        Set TheActiveWindow = ActiveWindow
        Set TempWindow = .NewWindow
        .Sheets(Array("Results")).Copy
       
    End With

    'Close temporary Window
    TempWindow.Close

    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007, we exit the sub when your answer is
            'NO in the security dialog that you only see when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    '    'Change all cells in the worksheets to values if you want
    '    For Each sh In Destwb.Worksheets
    '        sh.Select
    '        With sh.UsedRange
    '            .Cells.Copy
    '            .Cells.PasteSpecial xlPasteValues
    '            .Cells(1).Select
    '        End With
    '        Application.CutCopyMode = False
    '        Destwb.Worksheets(1).Select
    '    Next sh


    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & ""
    TempFileName = "Items of Interest in " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set olSent = OutApp.Session.GetDefaultFolder(5)
    Set olInBox = OutApp.Session.GetDefaultFolder(6)
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Jomili@sumdarnaddress.com"
            .CC = ""
            .BCC = ""
            .Subject = " Here are Items Needing Review "
            .Body = "The attached spreadsheet contains items noted on the current" & vbCrLf & "Report
as as needing attention. Please review this" & vbCrLf & "checklist and handle all items in a timely manner.
 This checklist" & vbCrLf & "will be reviewed when the next Report is posted." & vbCrLf &
vbCrLf & "Thanks" & vbCrLf & "Jomili" & vbCrLf & "Hard Worker" & vbCrLf
& "555-555-5556"
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:test.txt")
            .Send   'or use .Display
            AppActivate Application.Caption

        End With
        
        Application.Wait Now + TimeSerial(0, 0, 1)
        olSent.Items(olSent.Items.Count).Copy.Move olInBox
    
        
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have sent
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutApp = Nothing
    Set olSent = Nothing
    Set olInBox = Nothing
    Set OutMail = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
   
End Sub
This one copies the cells and pastes into a new spreadsheet
Sub Mail_Range()

'Works, but doesn't retain Headers, footers, print settings.
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim olInBox As Object
    Dim olSent As Object
    

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:W20000").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial paste:=8
        .Cells(1).PasteSpecial paste:=xlPasteValues
        .Cells(1).PasteSpecial paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & ""
    TempFileName = "Items of Interest in " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")
                 
    
    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    Set olSent = OutApp.Session.GetDefaultFolder(5)
    Set olInBox = OutApp.Session.GetDefaultFolder(6)
    

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Jomili@sumdarnaddress.com"
            .CC = ""
            .BCC = ""
            .Subject = "Items Needing Review "
            .Body = "The attached spreadsheet contains items noted on the current" & vbCrLf & "Report
as needing attention. Please review this" & vbCrLf & "checklist and handle all items in a timely manner. 
This checklist" & vbCrLf & "will be reviewed when the next Report is posted." & vbCrLf &
vbCrLf & "Thanks" & vbCrLf & "Jomili" & vbCrLf & "Hard Worker" & vbCrLf
& "555-555-5556"
            .Attachments.Add Dest.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

  Application.Wait Now + TimeSerial(0, 0, 1)
        olSent.Items(olSent.Items.Count).Copy.Move olInBox
    
        
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub


User Interface
New User Interface
The new results-oriented user interface makes it easy for you to work in Microsoft Office Excel. Commands and features that were often buried in complex menus and toolbars are now easier to find on task-oriented tabs that contain logical groups of commands and features. Many dialog boxes are replaced with dropdown galleries that display the available options, and descriptive tooltips or sample previews are provided to help you choose the right option.
No matter what activity you are performing in the new user interface, whether its formatting or analyzing data, Excel presents the tools that are most useful to successfully complete that task.
Introducing the new interface
There is a new look for Office Excel 2007, a new user interface (UI) that replaces menus, toolbars, and most of the task panes from previous versions of Excel with a single mechanism that is simple and apparent. The new user interface is designed to help you be more productive in Excel, more easily find the right features for various tasks, discover new functionality, and be more efficient.
The New Interface commands hierarchy:
1. Menu Tabs.
2. Ribbons.
3. Groups within each tab break a task into subtasks.
4. Command buttons (icons) in each group carry out a command or display a menu of commands.
Ribbon user interface: The primary replacement for menus and toolbars in Office Excel 2007 is the Ribbon. Designed for easy browsing, the Ribbon consists of tabs that are organized around specific scenarios or objects. The controls on each tab are further organized into several groups. The Ribbon can host richer content than menus and toolbars can, including buttons, galleries, and dialog box content.
Tabs that appear only when you need them: In addition to the standard set of tabs that you see on the Ribbon whenever you start Office Excel 2007, there are two other kinds of tabs, which appear in the interface and are useful for the type of task you are currently performing.
Contextual tools: Contextual tools enable you to work with an object that you select on the page, such as a table, a picture, or a drawing. When you click the object, the pertinent set of contextual tabs appears in an accent color next to the standard tabs.
Program tabs: Program tabs replace the standard set of tabs when you switch to certain authoring modes or views, including Print Preview.
File Button : This button is located in the upper-left corner of the Excel window and opens the menu shown here:

Quick Access Toolbar: The Quick Access Toolbar is located by default at the top of the Excel window and provides quick access to tools that you use frequently. You can customize the Quick Access Toolbar by adding commands to it.
Adding Commands to Quick Access Toolbar: In the Customize Quick Access Toolbar box, select either For all documents (as a default) or a specific document.
Click the command that you want to add, and then click Add.

Dialog Box Launchers: Dialog Box Launchers are small icons that appear in some groups. Clicking a Dialog Box Launcher opens a related dialog box or a task pane, providing more options related to that group.

Use the Keyboard to Access any Commands in the Ribbon
To use keyboard shortcut: To open a menu tab, press the Alt tab, now press a letter(s) or a number or a combination of a letter & a number , see below:
Step 1: press the Alt key or F10.
Step 2:
Press H, and then a letter(s) or a number or a combination of both (a letter & a number).
Or
Use the Tab key to move between command buttons in the Ribbon.
Memory management, Workbook, Worksheet & Cells
Memory Management
Memory management has been increased from 1 GB of memory in Microsoft Office Excel 2003 to 2 GB in Office Excel 2007.
You will also experience faster calculations in large, formula-intensive worksheets because Office Excel 2007 supports dual-processors and multithreaded chipsets.
Numbers of Rows, Columns & Cells in a Worksheet
Excel 2007 sheet contains 1,048,576 rows by 16,384 columns, total of 17,180,033,024 cells compare to previous Excel versions which hold 65,536 rows by 256 columns, total of 16,777,216 cells.
New file formats
XML-based file format: In 2007 Microsoft Office system, Microsoft is introducing new files formats for Word, Excel, and PowerPoint, known as the Microsoft Office Open XML formats. These new file formats facilitate integration with external data sources, and also offer reduced file sizes and improved data recovery. In Excel 2007, the default format for an Excel workbook is the Office Excel 2007 XML-based file format (.xlsx). Other available XML-based formats are the Excel 2007 XML-based and macro-enabled file format (.xlsm), the Excel 2007 file format for an Excel template (.xltx), and the Excel 2007 macro-enabled file format for an Excel template (.xltm).
Themes, Colors & Formatting
Office themes
In Office Excel 2007, you can quickly format the data in your worksheet by applying a theme and by using a specific style. Themes can be shared across other 2007 Office release applications, such as Microsoft Office Word and Microsoft Office PowerPoint, while styles are designed to change the format of Excel-specific items, such as Excel tables, charts, PivotTables, shapes, or diagrams.
Number of Colors
Excel 2007 supports up to 16 million colors.
Rich conditional formatting
You can implement and manage multiple Conditional Formatting rules that apply rich visual formatting in the form of gradient colors, data bars, and icon sets to data that meets those rules. Conditional formats are also easy to apply in just a few clicks, you can see relationships in your data that you can use for your analysis purposes.
Formulas & Functions
Easy formula writing
Resizable formula bar: The formula bar automatically resizes to accommodate long, complex formulas, which prevents the formulas from covering other data in your worksheet. You can also write longer formulas with more levels of nesting than you could in earlier versions of Excel.
Function AutoComplete: With Function AutoComplete, you can quickly write the proper formula syntax. From easily detecting the functions that you want to use, to getting help completing the formula arguments, you will be able to get formulas right the first time and every time.
Easy access to Named ranges: By using Name manager, you can organize, update, and manage multiple Named ranges in a central location, which helps all users who need to work on your worksheet interpret its formulas and data.
New Functions
Very important and useful functions are added to Excel 2007. The functions are IFERROR, AVERAGEIF, AVERAGEIFS, SUMIFS and COUNTIFS. Read more and see example in Chapter 9, page 155.
New OLAP formulas and cube functions
When you work with multidimensional databases (such as SQL Server Analysis Services) in Excel 2007, you can use OLAP formulas to build complex, free form, OLAP data bound reports. New cube functions are used to extract OLAP data (sets and values) from Analysis Services and display it in a cell. OLAP formulas can be generated when you convert PivotTable formulas to cell formulas or when you use AutoComplete for cube function arguments when you type formulas.
Charts
A New look of charts
You can use new charting tools to easily create professional-looking charts that communicate information effectively. Based on the theme that is applied to your workbook, the new, up-to-date look for charts includes special effects, such as 3-D, transparency, and soft shadows.
The new user interface makes it easy to explore the available chart types so that you can create the right chart for your data. Numerous predefined chart styles and layouts are provided so that you can quickly apply a good-looking format and include the details that you want in your chart.
Visual chart element pickers: Beside the quick layouts and quick formats, you can now use the new user interface to quickly change any element of the chart to best present your data. In a few clicks, you can add or remove titles, legends, data labels, trendlines, and other chart elements.
A modern look with OfficeArt: Since charts in Excel 2007 are drawn with OfficeArt, almost everything you can do to an OfficeArt shape can also be done to a chart and its elements. For example, you can add a soft shadow or a bevel effect to make an element to stand out or use transparency to make elements visible that are partially hidden in a chart layout. You can also use realistic 3-D effects.
Clear lines and fonts: Lines in charts appear less jagged, and ClearType fonts are used for text to improve readability.
More colors than ever: You can easily choose from the predefined theme colors and vary their color intensity. For more control, you can also add your own colors by choosing from 16 million colors in the Colors dialog box.
Chart templates: Saving your favorite charts as a chart template is much easier in the new user interface.
Shared charting
Using Excel charts in other applications: In Excel 2007, charting is shared between Excel, Word, and PowerPoint. Rather than using the charting features that are provided by Microsoft Graph, Word and PowerPoint now incorporate the powerful charting features of Excel. Since an Excel worksheet is used as the chart data sheet for Word and PowerPoint charts, shared charting provides the rich functionality of Excel, including the use of formulas, filtering, sorting, and the ability to link a chart to external data sources, such as Microsoft SQL Server and Analysis Services (OLAP), for up-to-date information in your chart. The Excel worksheet that contains the data of your chart can be stored in your Word document or PowerPoint presentation, or in a separate file to reduce the size of your documents.
Copying charts to other applications: Charts can be easily copied and pasted between documents or from one application to another. When you copy a chart from Excel to Word or PowerPoint, it automatically changes to match the Word document or PowerPoint presentation, but you can also retain the Excel chart format. The Excel worksheet data can be embedded in the Word document or PowerPoint presentation, but you can also leave it in the Excel source file.
Animating charts in PowerPoint: In PowerPoint, you can more easily use animation to emphasize data in an Excel-based chart. You can animate the entire chart or the legend entry and axis labels. In a column chart, you can even animate individual columns to better illustrate a specific point. Animation features are easier to find and give you much more control. For example, you can make changes to individual animation steps, and use more animation effects.
Sorting, Filtering & Tables
Improved sorting and filtering
You can now sort data by color and by more than 3 (and up to 64) levels. You can also filter data by color or by dates, display more than 1000 items in the AutoFilter dropdown list, select multiple items to filter, and filter data in PivotTables.
Excel table enhancements
You can use the new user interface to quickly create, format, and expand an Excel table (known as an Excel list in Excel 2003) to organize the data on your worksheet so that its much easier to work with.
PivotTables
Easy-to-use PivotTables
By using the new PivotTable user interface, the information that you want to view about your data is just a few clicks away. You no longer have to drag data to drop zones that arent always an easy target. Instead, you can simply select the fields that you want to see in a new PivotTable field list.
After you create a PivotTable, you can take advantage of many other new or improved features to summarize, analyze, and format your PivotTable data.
Sharing & Connections
New ways to share your work
Using Excel Services to share your work: If you have access to Excel Services, you can use it to share your Office Excel 2007 worksheet data with other users, such as executives and other stakeholders in your organization. In Excel 2007, you can save a workbook to Excel Services and specify the worksheet data that you want other people to see. In a browser (browser: Software that interprets HTML files, formats them into Web pages, and displays them. A Web browser, such as Microsoft Internet Explorer, can follow hyperlinks, transfer files, and play sound or video files that are embedded in Web pages.), they can then use Microsoft Office Excel Web Access to view, analyze, print, and extract this worksheet data. They can also create a static snapshot of the data at regular intervals or on demand. Excel Web Access makes it easy to perform activities, such as scrolling, filtering, sorting, viewing charts, and using drill-down in PivotTables. You can also connect the Excel Web Access Web Part to other Web Parts to display data in alternative ways. And with the right permissions, Excel Web Access users can open a workbook in Excel 2007 so that they can use the full power of Excel to analyze and work with the data on their own computers if they have Excel installed.
Using this method to share your work ensures that other users have access to one version of the data in one location, which you can keep current with the latest details. If you need other users, such as team members, to supply you with comments and updated information, you may want to share a workbook the same way.
Quick connections to external data
You no longer need to know the server or database names of corporate data sources. Instead, you can use Quick Launch to select from a list of data sources that your administrator or workgroup expert has made available for you. A connection manager in Excel allows you to view all connections in a workbook and make it easier to reuse a connection or to substitute a connection with another user.
Printing
Better printing experience
Page Layout View: In addition to the Normal view and Page Break Preview view, Excel 2007 provides a Page Layout View. You can use this view to create a worksheet while keeping an eye on how it will look in printed format. In this view, you can work with page headers, footers, and margin settings right in the worksheet, and place objects, such as charts or shapes, exactly where you want them to be. You also have easy access to all page setup options on the Page Layout tab in the new user interface so that you can quickly specify options, such as page orientation. Its easy to see what will be printed on every page, which will help you avoid multiple printing attempts and truncated data in printouts.
Saving to PDF and XPS format: Like other 2007 Office release applications, Excel 2007 supports saving a workbook to a high-fidelity fixed file format, such as Portable Document Format (PDF) or XML Paper Specification (XPS) format, that encapsulates how it will look when it is printed. This allows you to share the content of your workbook in a format that is easy for other people to view online or print, without including the underlying formulas, external data queries, or comments.
Actually, this is what you did in earlier versions of Excel to collect the information you need before you save it to Excel Services.
Using Document Management Server: Excel Services can be integrated with Document Management Server to create a validation process around new Excel reports and workbook calculation workflow actions, such as a cell-based notification or a workflow process based on a complex Excel calculation. You can also use Document Management Server to schedule nightly recalculation of a complex workbook model.

I am working on setting up a footer that can't be changed. The code I used is
Private Sub Workbook_BeforePrint(Cancel As Boolean)
With ActiveSheet.PageSetup
'.LeftHeader = "header"
'.CenterHeader = ""
'.RightHeader = ""
.LeftFooter = "footer"
'.CenterFooter = ""
'.RightFooter = ""
End With
End Sub
(Courtesy of a previous thread)

This works perfectly for all my tabs except the Chart that is created by a macro. When I test the above code for that tab by using print preview, I get "Run-time error '1004': Unable to set the LeftFooter property of the PageSetup class"

The chart is made using the following code

Sub
MakeAPlot()
'This macro will delete an old plot if it exists and generate a new plot using only the applicable data range
   
    Dim rChartXData As Range
    Dim rChartYData As Range
    Worksheets("PLOT Data").Cells(6, 1).Select                          'select a single cell as the initial plot
data

    
    On Error Resume Next                                                ' remove existing chart if exists
    Application.DisplayAlerts = False
    ActiveWorkbook.Charts("aaa").delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    
    With ActiveSheet                                                    ' determine chart data ranges using only actual data
        Set rChartXData = .Range(.Range("G2"), .Range("G2").End(xlDown))
        Set rChartYData = rChartXData.Offset(, 1)
    End With

    
    With ActiveSheet.Shapes.AddChart.Chart                              'create new chart in PLOT DATA
        .ChartArea.ClearContents                                        'clear any existing chart contents
        
        With .SeriesCollection.NewSeries                                'add the new series of selected data
         m = Sheets("REPORT").Cells(2, "I")
         yr = Sheets("REPORT").Cells(2, "J")
         .Name = "Report ending " & m & " " & yr                   'Chart title
            .Values = rChartYData
            .XValues = rChartXData
        End With

     ' .ChartType = xl3DColumnStacked
       .ChartType = xlColumnStacked                                     'select the chart type
        .Legend.delete                                                  'delete the legend-not needed
        .Axes(xlCategory).HasTitle = True                               'title the graph and axes
        .Axes(xlValue).HasTitle = True
        .Axes(xlCategory).AxisTitle.Characters.Text = "bbb"
        .Axes(xlValue).AxisTitle.Characters.Text = "ccc"
        
        .Location xlLocationAsNewSheet, "Graph"               'move the graph to its own sheet
        
        
        With ActiveSheet.PageSetup                                      'insert header and footer
         .LeftHeader = ""
         .CenterHeader = "&""Calibri,Bold""&18 issues"  
         .RightHeader = ""
         .LeftFooter = "FOOTER"              
         .CenterFooter = "&T  &D"
         .RightFooter = ""
        End With
    End With

End Sub
Doing some investigating, the cause of the error is supposed to be not having a default printer set-up. I am stuck because I do have a default printer set-up; more confusing for me is that the first code works on every single tab in the workbook EXCEPT the chart. The chart has the same level of protection set as several of the other tabs also; the larger macro handles the protection for the sheets.

Any thoughts on what is triggering the error or what else to check would be greatly appreciated. Thank you.

I've been tasked with writing a "screen designer" tool in Excel to help alleviate the tedium of filling in form after form by our clients.

All was going swimmingly until I started on the great idea to have it transfer all the data from the client's design changes (approx 20 worksheets involved) into a large report in Word. This report would then be given to the design team to help generate the website a lot quicker.

The code seems to work in that variables stored on a worksheet called 'Results' are transferred to the Word document via Word bookmarks. Ignore the one copying a range of cells (unless you can fix that one) as it's a recent addition to the code and I know it doesn't work as of yet (Errors #13 or #1004).

The same error keeps on cropping up:

"Error 462" - it'll work the first time but will fail every single time thereafter. I've looked up various solutions in Google and they all say that I should be making sure I close the Word Object once I've finished with it. This I've made sure I'm doing.

My code is taken from various sources (the three books on VBA I've bought in the last month plus this site and a few others found by Googling):


	VB:
	
 CommandButton2_Click() 
     
    Dim details As String 
    Dim template As String 
     
    Set objWord = CreateObject("Word.Application") 
     
    If Err.Number = 429 Then 
        Set objWord = CreateObject("Word.Application") 
        Err.Number = 0 
    End If 
     
    On Error Goto Finally 
     
     ' The template file *must* be in the same folder as the UDP spreadsheet
    template = ThisWorkbook.Path & "UDPTemplate.dot" 
     
     ' Ask Word to create a new document based on the template
    objWord.Documents.Add template 
     
    Set doc = ActiveDocument 
     
     ' Just checking it's our template.  No bookmarks = not our template
     
    If doc.Bookmarks.Count < 1 Then 
        MsgBox "Template not launched - no bookmarks found!", vbCritical & vbOKOnly 
        Exit Sub 
    End If 
     
    With doc 
         
         ' Headers & footers
        .Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "UDP Design Document v1.0" 
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = Range("Results!B5").Value & " for " &
Range("Results!B3").Value 
         
         ' Bookmarked areas
        .Bookmarks.Item("ClientName").Range.Text = Range("Results!B3").Value 
        .Bookmarks.Item("WebsiteName").Range.Text = Range("Results!B5").Value 
        .Bookmarks.Item("ProjectDate").Range.Text = Range("Results!B7").Value 
        .Bookmarks.Item("ProjectVersion").Range.Text = Range("Results!B9").Value 
        .Bookmarks.Item("ProjectManager").Range.Text = Range("Results!B11").Value 
         
         ' *** This bit doesn't work - either error #13 or #1004 ***
        .Bookmarks.Item("ButtonsTable").Range.Text = Range("Buttons!A4:B29") 
         
    End With 
     
     ' Switch on Word
    objWord.Visible = True 
     
     
     ' Exit with error code trap if required
Finally: 
     
    If Err.Number  0 Then 
        MsgBox "An error occured during Word transfer" & vbCr & vbCr & "Error #" & Err.Number 
        objWord.Application.Quit 'Close app
        Set objWord = Nothing 
        Set doc = Nothing 
    Else 
        objWord.Application.Quit 'Close app
        Set objWord = Nothing 
        Set doc = Nothing 
    End If 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
As you can see the error handler at the end gives me a heads-up if any error occurs but regardless of which outcome (error or not), the program still works on the first run and crashes every other time after. I'm "closing down" Word correctly - but guess Word & Excel don't realise that.

Bound to be something simple I've overlooked but what is it?

Many thanks

Mike


No luck finding an answer? You could always try Google.