Emailing Only Visible Cells

sGraham24

New Member
Joined
May 8, 2024
Messages
10
Office Version
  1. 365
  2. 2011
Platform
  1. Windows
Hello. Novice VBA user here. I have this code, which works, to email an entire spreadsheet, however I want it to only email the visible cells and NOT the hidden ones. How do I do this?


' This routine will send the Project Leader Project Status Sheet
'
Private Sub SendProjectLeaderProjectStatusToISOEmail(Email As String)
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim reportperiod As String
Dim slin As String
Dim budget As String
Dim currentmonthlytotal As String
Dim total As String
Dim balance As String
Dim percentcomplete As String
Dim popstart As String
Dim popend As String
Dim followonproject As String
Dim projectleaderemail As String

Dim reportperiodLength As String
Dim slinLength As String
Dim budgetLength As String
Dim currentmonthlytotalLength As String
Dim totalLength As String
Dim balanceLength As String
Dim percentcompleteLength As String
Dim popstartLength As String
Dim popendLength As String
Dim followonprojectLength As String
Dim projectleaderemailLength As String
Dim spaceString As String



'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
iCounter = 4

'Select the ActiveCell on that worksheet
Set rng = ActiveCell

'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
.Sender = Email
.To = Email
.Subject = "Project Leader Project Status" + Format(Now, " YYYY-MM-DD")
.HTMLBody = "<P STYLE='font-family:Courier New;font-size:8pt;color: rgb(0,0,0)'><br><pre>"

Do While Sheets("Project Leader Project Status").Cells(iCounter, 1).Text <> ""
reportperiod = Sheets("Project Leader Project Status").Cells(iCounter, 1).Text
slin = Sheets("Project Leader Project Status").Cells(iCounter, 1).Text
budget = Sheets("Project Leader Project Status").Cells(iCounter, 2).Text
currentmonthlytotal = Sheets("Project Leader Project Status").Cells(iCounter, 3).Text
total = Sheets("Project Leader Project Status").Cells(iCounter, 4).Text
balance = Sheets("Project Leader Project Status").Cells(iCounter, 5).Text
percentcomplete = Sheets("Project Leader Project Status").Cells(iCounter, 6).Text
popstart = Sheets("Project Leader Project Status").Cells(iCounter, 7).Text
popend = Sheets("Project Leader Project Status").Cells(iCounter, 8).Text
followonproject = Sheets("Project Leader Project Status").Cells(iCounter, 9).Text
projectleaderemail = Sheets("Project Leader Project Status").Cells(iCounter, 10).Text

reportperiodLength = Len(reportperiod)
slinLength = Len(slin)
budgetLength = Len(budget)
currentmonthlytotalLength = Len(currentmonthlytotal)
totalLength = Len(total)
balanceLength = Len(balance)
percentcompleteLength = Len(percentcomplete)
popstartLength = Len(popstart)
popendLength = Len(popend)
followonprojectLength = Len(followonproject)
projectleaderemailLength = Len(projectleaderemail)

If reportperiodLength > 9 Then
spaceString = ""
Else
spaceString = String(10 - reportperiodLength, " ")
End If
reportperiod = reportperiod + spaceString

If slinLength > 22 Then
spaceString = ""
Else
spaceString = String(23 - slinLength, " ")
End If
slin = slin + spaceString

If budgetLength > 9 Then
spaceString = ""
Else
spaceString = String(10 - budgetLength, " ")
End If
budget = budget + spaceString

If currentmonthlytotalLength > 8 Then
spaceString = ""
Else
spaceString = String(9 - currentmonthlytotalLength, " ")
End If
currentmonthlytotal = currentmonthlytotal + spaceString

If totalLength > 7 Then
spaceString = ""
Else
spaceString = String(8 - totalLength, " ")
End If
total = total + spaceString

If balanceLength > 8 Then
spaceString = ""
Else
spaceString = String(9 - balanceLength, " ")
End If
balance = balance + spaceString

If percentcompleteLength > 11 Then
spaceString = ""
Else
spaceString = String(12 - percentcompleteLength, " ")
End If
percentcomplete = percentcomplete + spaceString

If popstartLength > 10 Then
spaceString = ""
Else
spaceString = String(11 - popstartLength, " ")
End If
popstart = popstart + spaceString

If popendLength > 12 Then
spaceString = ""
Else
spaceString = String(13 - popendLength, " ")
End If
popend = popend + spaceString

If followonprojectLength > 10 Then
spaceString = ""
Else
spaceString = String(11 - followonprojectLength, " ")
End If
followonproject = followonproject + spaceString

If projectleaderemailLength > 35 Then
spaceString = ""
Else
spaceString = String(36 - projectleaderemailLength, " ")
End If
projectleaderemail = projectleaderemail + spaceString

.HTMLBody = .HTMLBody + slin + budget + currentmonthlytotal + total + balance + percentcomplete + popstart + popend + followonproject + projectleaderemail + "<br>"
iCounter = iCounter + 1
Loop
.HTMLBody = .HTMLBody + "</pre>"
.Send
End With

'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
See if this does what you are expecting:
VBA Code:
' This routine will send the Project Leader Project Status Sheet
'
Private Sub SendProjectLeaderProjectStatusToISOEmail_mod(Email As String)
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim reportperiod As String
Dim slin As String
Dim budget As String
Dim currentmonthlytotal As String
Dim total As String
Dim balance As String
Dim percentcomplete As String
Dim popstart As String
Dim popend As String
Dim followonproject As String
Dim projectleaderemail As String

Dim reportperiodLength As String
Dim slinLength As String
Dim budgetLength As String
Dim currentmonthlytotalLength As String
Dim totalLength As String
Dim balanceLength As String
Dim percentcompleteLength As String
Dim popstartLength As String
Dim popendLength As String
Dim followonprojectLength As String
Dim projectleaderemailLength As String
Dim spaceString As String

Dim shStatus As Worksheet
Dim rngVisible As Range
Dim rCell As Range
Dim LastCell As Range

Set shStatus = Sheets("Project Leader Project Status")
With shStatus
    Set LastCell = .Columns("A").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    Set rngVisible = .Range("A4:A" & LastCell.Row).SpecialCells(xlCellTypeVisible)
End With

'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)

'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
    .Sender = Email
    .To = Email
    .Subject = "Project Leader Project Status" + Format(Now, " YYYY-MM-DD")
    .HTMLBody = "<P STYLE='font-family:Courier New;font-size:8pt;color: rgb(0,0,0)'><br><pre>"
    
    For Each rCell In rngVisible
        iCounter = rCell.Row
        reportperiod = shStatus.Cells(iCounter, 1).Text
        slin = shStatus.Cells(iCounter, 1).Text
        budget = shStatus.Cells(iCounter, 2).Text
        currentmonthlytotal = shStatus.Cells(iCounter, 3).Text
        total = shStatus.Cells(iCounter, 4).Text
        balance = shStatus.Cells(iCounter, 5).Text
        percentcomplete = shStatus.Cells(iCounter, 6).Text
        popstart = shStatus.Cells(iCounter, 7).Text
        popend = shStatus.Cells(iCounter, 8).Text
        followonproject = shStatus.Cells(iCounter, 9).Text
        projectleaderemail = shStatus.Cells(iCounter, 10).Text
        
        reportperiodLength = Len(reportperiod)
        slinLength = Len(slin)
        budgetLength = Len(budget)
        currentmonthlytotalLength = Len(currentmonthlytotal)
        totalLength = Len(total)
        balanceLength = Len(balance)
        percentcompleteLength = Len(percentcomplete)
        popstartLength = Len(popstart)
        popendLength = Len(popend)
        followonprojectLength = Len(followonproject)
        projectleaderemailLength = Len(projectleaderemail)
        
        If reportperiodLength > 9 Then
            spaceString = ""
        Else
            spaceString = String(10 - reportperiodLength, " ")
        End If
        reportperiod = reportperiod + spaceString
        
        If slinLength > 22 Then
            spaceString = ""
        Else
            spaceString = String(23 - slinLength, " ")
        End If
        slin = slin + spaceString
        
        If budgetLength > 9 Then
            spaceString = ""
        Else
            spaceString = String(10 - budgetLength, " ")
        End If
        budget = budget + spaceString
        
        If currentmonthlytotalLength > 8 Then
            spaceString = ""
        Else
            spaceString = String(9 - currentmonthlytotalLength, " ")
        End If
        currentmonthlytotal = currentmonthlytotal + spaceString
        
        If totalLength > 7 Then
            spaceString = ""
        Else
            spaceString = String(8 - totalLength, " ")
        End If
        total = total + spaceString
        
        If balanceLength > 8 Then
            spaceString = ""
        Else
            spaceString = String(9 - balanceLength, " ")
        End If
        balance = balance + spaceString
        
        If percentcompleteLength > 11 Then
            spaceString = ""
        Else
            spaceString = String(12 - percentcompleteLength, " ")
        End If
        percentcomplete = percentcomplete + spaceString
        
        If popstartLength > 10 Then
            spaceString = ""
        Else
            spaceString = String(11 - popstartLength, " ")
        End If
        popstart = popstart + spaceString
        
        If popendLength > 12 Then
            spaceString = ""
        Else
            spaceString = String(13 - popendLength, " ")
        End If
        popend = popend + spaceString
        
        If followonprojectLength > 10 Then
            spaceString = ""
        Else
            spaceString = String(11 - followonprojectLength, " ")
        End If
        followonproject = followonproject + spaceString
        
        If projectleaderemailLength > 35 Then
            spaceString = ""
        Else
            spaceString = String(36 - projectleaderemailLength, " ")
        End If
        projectleaderemail = projectleaderemail + spaceString
        
        .HTMLBody = .HTMLBody + slin + budget + currentmonthlytotal + total + balance + percentcomplete + popstart + popend + followonproject + projectleaderemail + "<br>"
    Next rCell
    .HTMLBody = .HTMLBody + "</pre>"
    .Send
End With

'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub
 
Upvote 0
Solution
See if this does what you are expecting:
VBA Code:
' This routine will send the Project Leader Project Status Sheet
'
Private Sub SendProjectLeaderProjectStatusToISOEmail_mod(Email As String)
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim reportperiod As String
Dim slin As String
Dim budget As String
Dim currentmonthlytotal As String
Dim total As String
Dim balance As String
Dim percentcomplete As String
Dim popstart As String
Dim popend As String
Dim followonproject As String
Dim projectleaderemail As String

Dim reportperiodLength As String
Dim slinLength As String
Dim budgetLength As String
Dim currentmonthlytotalLength As String
Dim totalLength As String
Dim balanceLength As String
Dim percentcompleteLength As String
Dim popstartLength As String
Dim popendLength As String
Dim followonprojectLength As String
Dim projectleaderemailLength As String
Dim spaceString As String

Dim shStatus As Worksheet
Dim rngVisible As Range
Dim rCell As Range
Dim LastCell As Range

Set shStatus = Sheets("Project Leader Project Status")
With shStatus
    Set LastCell = .Columns("A").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    Set rngVisible = .Range("A4:A" & LastCell.Row).SpecialCells(xlCellTypeVisible)
End With

'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)

'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
    .Sender = Email
    .To = Email
    .Subject = "Project Leader Project Status" + Format(Now, " YYYY-MM-DD")
    .HTMLBody = "<P STYLE='font-family:Courier New;font-size:8pt;color: rgb(0,0,0)'><br><pre>"
   
    For Each rCell In rngVisible
        iCounter = rCell.Row
        reportperiod = shStatus.Cells(iCounter, 1).Text
        slin = shStatus.Cells(iCounter, 1).Text
        budget = shStatus.Cells(iCounter, 2).Text
        currentmonthlytotal = shStatus.Cells(iCounter, 3).Text
        total = shStatus.Cells(iCounter, 4).Text
        balance = shStatus.Cells(iCounter, 5).Text
        percentcomplete = shStatus.Cells(iCounter, 6).Text
        popstart = shStatus.Cells(iCounter, 7).Text
        popend = shStatus.Cells(iCounter, 8).Text
        followonproject = shStatus.Cells(iCounter, 9).Text
        projectleaderemail = shStatus.Cells(iCounter, 10).Text
       
        reportperiodLength = Len(reportperiod)
        slinLength = Len(slin)
        budgetLength = Len(budget)
        currentmonthlytotalLength = Len(currentmonthlytotal)
        totalLength = Len(total)
        balanceLength = Len(balance)
        percentcompleteLength = Len(percentcomplete)
        popstartLength = Len(popstart)
        popendLength = Len(popend)
        followonprojectLength = Len(followonproject)
        projectleaderemailLength = Len(projectleaderemail)
       
        If reportperiodLength > 9 Then
            spaceString = ""
        Else
            spaceString = String(10 - reportperiodLength, " ")
        End If
        reportperiod = reportperiod + spaceString
       
        If slinLength > 22 Then
            spaceString = ""
        Else
            spaceString = String(23 - slinLength, " ")
        End If
        slin = slin + spaceString
       
        If budgetLength > 9 Then
            spaceString = ""
        Else
            spaceString = String(10 - budgetLength, " ")
        End If
        budget = budget + spaceString
       
        If currentmonthlytotalLength > 8 Then
            spaceString = ""
        Else
            spaceString = String(9 - currentmonthlytotalLength, " ")
        End If
        currentmonthlytotal = currentmonthlytotal + spaceString
       
        If totalLength > 7 Then
            spaceString = ""
        Else
            spaceString = String(8 - totalLength, " ")
        End If
        total = total + spaceString
       
        If balanceLength > 8 Then
            spaceString = ""
        Else
            spaceString = String(9 - balanceLength, " ")
        End If
        balance = balance + spaceString
       
        If percentcompleteLength > 11 Then
            spaceString = ""
        Else
            spaceString = String(12 - percentcompleteLength, " ")
        End If
        percentcomplete = percentcomplete + spaceString
       
        If popstartLength > 10 Then
            spaceString = ""
        Else
            spaceString = String(11 - popstartLength, " ")
        End If
        popstart = popstart + spaceString
       
        If popendLength > 12 Then
            spaceString = ""
        Else
            spaceString = String(13 - popendLength, " ")
        End If
        popend = popend + spaceString
       
        If followonprojectLength > 10 Then
            spaceString = ""
        Else
            spaceString = String(11 - followonprojectLength, " ")
        End If
        followonproject = followonproject + spaceString
       
        If projectleaderemailLength > 35 Then
            spaceString = ""
        Else
            spaceString = String(36 - projectleaderemailLength, " ")
        End If
        projectleaderemail = projectleaderemail + spaceString
       
        .HTMLBody = .HTMLBody + slin + budget + currentmonthlytotal + total + balance + percentcomplete + popstart + popend + followonproject + projectleaderemail + "<br>"
    Next rCell
    .HTMLBody = .HTMLBody + "</pre>"
    .Send
End With

'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub
Thank you Alex! This did exactly what I needed. I appreciate your help with this.
 
Upvote 0

Forum statistics

Threads
1,223,884
Messages
6,175,175
Members
452,615
Latest member
bogeys2birdies

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