code to include a column or more based on checkbox

M

mecerrato

Board Regular
Joined
Oct 5, 2015
Messages
184
Office Version
  1. 365
Platform
  1. Windows
I have this code that sends a range as a picture into an outlook email. I added checkboxes and want to be able to modify the code to send the contents in range B4:B17 and one or all of C,D, and E depending on if the checkbox is true.
I have no idea how to do this, can anyone help me?
VBA Code: 
Sub Screen2ShotMain()
    Dim rng As Range
    Dim olApp As Object
    Dim Email As Object
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Rows("11:11").Select
    Selection.EntireRow.Hidden = True

    Set rng = Sheets("Calc").Range("B4:C16")
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set olApp = CreateObject("Outlook.Application")
    Set Email = olApp.CreateItem(0)

    With Email
      '.To = "damor"
      .CC = ""
      .BCC = ""
      .Subject = "Forward Commitment" ' & Range("F5").Value
      .Body = "Please see details of forward commitment as discussed" & vbCr & vbCr
      .Display
      DoEvents
        Set wdDoc = Email.GetInspector.WordEditor
        Set wdRng = wdDoc.Application.ActiveDocument.Content
        wdRng.Collapse Direction:=wdCollapseEnd
        rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wdRng.PasteSpecial DataType:=3
      .Display
    End With

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

    Set Email = Nothing
    Set olApp = Nothing
    Rows("11:11").Select
    Selection.EntireRow.Hidden = False
    ActiveSheet.Protect Password:="Mortgage1"
End Sub

1728652318017.png
 

Attachments

  • 1728652149259.png
    1728652149259.png
    24.8 KB · Views: 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
Please try this. I'm assuming that those checkboxes in C5:E5 are the new style where the value is True or False. I didn't test this because I don't have your data.

Xl2BB is a great tool for posting examples


VBA Code: 
Sub Screen2ShotMain()
    Dim rng As Range
    Dim olApp As Object
    Dim Email As Object
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim Cel As Range
   
    Rows("11:11").Select
    Selection.EntireRow.Hidden = True

    Set rng = Sheets("Calc").Range("B4:C17")
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
   
    For Each Cel In Range("C5:E5")
      If Cel.Value = True Then
        Set rng = Union(rng, Intersect(Range("4:17"), Cel.EntireColumn))
      End If
    Next Cel

    Set olApp = CreateObject("Outlook.Application")
    Set Email = olApp.CreateItem(0)

    With Email
      '.To = "damor"
      .CC = ""
      .BCC = ""
      .Subject = "Forward Commitment" ' & Range("F5").Value
      .Body = "Please see details of forward commitment as discussed" & vbCr & vbCr
      .Display
      DoEvents
        Set wdDoc = Email.GetInspector.WordEditor
        Set wdRng = wdDoc.Application.ActiveDocument.Content
        wdRng.Collapse Direction:=wdCollapseEnd
        rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wdRng.PasteSpecial DataType:=3
      .Display
    End With

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

    Set Email = Nothing
    Set olApp = Nothing
    Rows("11:11").Select
    Selection.EntireRow.Hidden = False
    ActiveSheet.Protect Password:="Mortgage1"
End Sub
 
Upvote 0
IF that doesn't work, we may have to try and hide the columns that are unchecked, then specify the entire range.
 
Upvote 0
Jeffrey Mahoney said:
Please try this. I'm assuming that those checkboxes in C5:E5 are the new style where the value is True or False. I didn't test this because I don't have your data.

Xl2BB is a great tool for posting examples


VBA Code: 
Sub Screen2ShotMain()
    Dim rng As Range
    Dim olApp As Object
    Dim Email As Object
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim Cel As Range
  
    Rows("11:11").Select
    Selection.EntireRow.Hidden = True

    Set rng = Sheets("Calc").Range("B4:C17")
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
  
    For Each Cel In Range("C5:E5")
      If Cel.Value = True Then
        Set rng = Union(rng, Intersect(Range("4:17"), Cel.EntireColumn))
      End If
    Next Cel

    Set olApp = CreateObject("Outlook.Application")
    Set Email = olApp.CreateItem(0)

    With Email
      '.To = "damor"
      .CC = ""
      .BCC = ""
      .Subject = "Forward Commitment" ' & Range("F5").Value
      .Body = "Please see details of forward commitment as discussed" & vbCr & vbCr
      .Display
      DoEvents
        Set wdDoc = Email.GetInspector.WordEditor
        Set wdRng = wdDoc.Application.ActiveDocument.Content
        wdRng.Collapse Direction:=wdCollapseEnd
        rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wdRng.PasteSpecial DataType:=3
      .Display
    End With

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

    Set Email = Nothing
    Set olApp = Nothing
    Rows("11:11").Select
    Selection.EntireRow.Hidden = False
    ActiveSheet.Protect Password:="Mortgage1"
End Sub
Click to expand...
Jeffrey Mahoney said:
Please try this. I'm assuming that those checkboxes in C5:E5 are the new style where the value is True or False. I didn't test this because I don't have your data.

Xl2BB is a great tool for posting examples


VBA Code: 
Sub Screen2ShotMain()
    Dim rng As Range
    Dim olApp As Object
    Dim Email As Object
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim Cel As Range
  
    Rows("11:11").Select
    Selection.EntireRow.Hidden = True

    Set rng = Sheets("Calc").Range("B4:C17")
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
  
    For Each Cel In Range("C5:E5")
      If Cel.Value = True Then
        Set rng = Union(rng, Intersect(Range("4:17"), Cel.EntireColumn))
      End If
    Next Cel

    Set olApp = CreateObject("Outlook.Application")
    Set Email = olApp.CreateItem(0)

    With Email
      '.To = "damor"
      .CC = ""
      .BCC = ""
      .Subject = "Forward Commitment" ' & Range("F5").Value
      .Body = "Please see details of forward commitment as discussed" & vbCr & vbCr
      .Display
      DoEvents
        Set wdDoc = Email.GetInspector.WordEditor
        Set wdRng = wdDoc.Application.ActiveDocument.Content
        wdRng.Collapse Direction:=wdCollapseEnd
        rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wdRng.PasteSpecial DataType:=3
      .Display
    End With

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

    Set Email = Nothing
    Set olApp = Nothing
    Rows("11:11").Select
    Selection.EntireRow.Hidden = False
    ActiveSheet.Protect Password:="Mortgage1"
End Sub
Click to expand...
It did not work, I am gonna try this xlbb thing for the first time, tell me if it works to help resolve:

Forward Commitment Calculator2.xlsm
B
8Lock Term
Calc
 
Upvote 0
mecerrato said:
It did not work, I am gonna try this xlbb thing for the first time, tell me if it works to help resolve:

Forward Commitment Calculator2.xlsm
B
8Lock Term
Calc
Click to expand...
Forward Commitment Calculator2.xlsm
BCDE
2
3Fill in Yellow fields ONLY
4DescAmount
5Check to include in email
6Target Amount$ 3,000,000$ 4,000,000$ 5,000,000
7Target Rate4.99%4.99%4.99%
8Lock Term909090
9
10Rate Sheet Cost (60 day)6.4996.4996.499
12PE-1.500-1.500-1.500
13Total Points5.2494.9994.999
14
15Total Due$ 157,470$ 199,960$ 249,950
16Due upon agreement$ 30,000$ 40,000$ 50,000
17Due upon completion$ 127,470$ 159,960$ 199,950
Calc
 
Upvote 0
mecerrato said:
It did not work, I am gonna try this xlbb thing for the first time, tell me if it works to help resolve:

Forward Commitment Calculator2.xlsm
B
8Lock Term
Calc
Click to expand...
Forward Commitment Calculator.xlsm
E
64.99%
Calc
 
Upvote 0
Jeffrey Mahoney said:
IF that doesn't work, we may have to try and hide the columns that are unchecked, then specify the entire range.
Click to expand...
Forward Commitment Calculator.xlsm
BCDE
4DescAmount
5Target Amount$ 3,000,000$ 4,000,000$ 5,000,000
6Target Rate4.99%4.99%4.99%
7Lock Term909090
8
9Rate Sheet Cost (60 day)6.4996.4996.499
10Lock Fee0.2500.0000.000
11PE-1.500-1.500-1.500
12Total Points5.2494.9994.999
13
14Total Due$ 157,470$ 199,960$ 249,950
15Due upon agreement$ 30,000$ 40,000$ 50,000
16Due upon completion$ 127,470$ 159,960$ 199,950
Calc
Cell Formulas
RangeFormula
C10:E10C10=IF(C7=Data!B3,Data!C3,IF(C7=Data!B4,Data!C4,Data!C5))
C12:E12C12=SUM(C9:C11)
C14:E14C14=C5*(C12/100)
C15:E15C15=C5*0.01
C16:E16C16=C14-C15
Cells with Data Validation
CellAllowCriteria
C7:E7List=Data!$B$3:$B$5
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Add text before pasting pic in outlook
Replies
2
Views
57
DanteAmor
DanteAmor
M
  • Question Question
VBA Code to make a strung variable bold and underline
Replies
3
Views
1K
Micron
M
J
  • Question Question
VBA to send multiple emails with multiple attachments
Replies
5
Views
567
6StringJazzer
6StringJazzer
M
  • Question Question
VBA Code to save picture file to SharePoint Location - need path vba code
Replies
1
Views
342
Micron
M
N
  • Question Question
VBA Code - add emails to outlook BCC from list (that updates)
Replies
1
Views
336
NormChart55
N

Forum statistics

Threads
1,222,830
Messages
6,168,509
Members
452,194
Latest member
Lowie27

Share this page

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