Copy only visible columns with conditional Formatting

Hello,

Can I start by thanking the people in this forum for the wealth of knowledge contained within it. It makes things accessible, even for a complete novice like myself.

Ok, on to my request for help, as I cannot get over this hurdle....

I am building a data tracker for my research lab, where an analyst can highlight a selection of data and by clicking a button, send the data to the team.

I have a set of buttons in my spreadsheet that will hide all columns, except some up front info columns (colums B:I) followed by the chosen test data. (e.g. click "Karl Fischer" and columns B:I (info columns) will display followed by columns BB:BC (test data)

Alot of the columns from J:BC have conditional formatting in them, and I was aided greatly by another thread in this forum which creates the email with the conditional formatting:- https://www.excelforum.com/excel-pro...ml#post4626411

However, the goal is that we will be able display certain data (using buttons), highlight the visible cells starting in column B, and by clicking "Email Results to Team" the selected table (visible) will be copied accross to an email with the conditonal formating.

I have tried hard to build in the funtionality to only copy the visible cells, taking infomation from https://www.rondebruin.nl/win/s1/outlook/bmail2.htm with the following code:-

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

However, I am just not knowledgable enough to add this funtionality...

The code I got from the previous thread in this forum does everything I need it to do, except to only copy across only visible cells. I would be very grateful for any guidence that could be offered by more skilled fellow humans!

The code I would like to modify, is in Module 5 and below

'Written: September 22, 2008
'Updated: August 18, 2011
'Author:  Leith Ross
'Summary: Send a specfied worksheet range in the body of an Outlook email
'         in HTML format.

Sub EmailRangeInHTML(ByVal Recipient As String, ByVal Subject As String, Optional Range_To_Send As Variant)

  Dim FSO As Object
  Dim HTMLcode As String
  Dim HTMLfile As Object
  Dim MyApp As Boolean
  Dim olApp As Object
  Dim Rng As Range
  Dim TempFile As String
  Dim Wks As Worksheet
  Dim strto As String
  Dim strbody As String

  Const ForReading As Long = 1
  Const olMailItem = 0
  Const olFormatHTML = 2
  Const UseDefault As Long = -2
    
    strbody = "Hello" & "<br><br>" & _
              "Please see the table below for the recently generated results" & "<br><br>" & _
              "The project tracker has been updated and can be found "
    strbody = strbody & "<A href=""" & ThisWorkbook.Sheets("Lookupdata").Range("H3") & """>HERE</a > "
    
    For Each cell In ThisWorkbook.Sheets("Lookupdata").Range("F3:E50")
    If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
    strto = strto & cell.Value & ";"
    End If
    Next cell
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

    
     On Error GoTo CleanUp
     
     If IsMissing(Range_To_Send) Then
        Set Rng = Selection
     Else
        Select Case TypeName(Range_To_Send)
          Case Is = "Range"
              Set Rng = Selection
          Case Is = "String"
              Set Rng = Evaluate(Range_To_Send)
          Case Else
              MsgBox "Your Selection is Not a Valid Range."
              GoTo CleanUp
        End Select
     End If
     
     ' Copy the worksheet to create a new workbook
       Set Wks = Rng.Parent
       Wks.Copy
     
     ' The new workbook will be saved to the user's Temp directoy
       TempFile = Environ("Temp") & "\" & Wks.Name & ".htm"
     
     ' If a file by this exists then delete it
       If Dir(TempFile) <> "" Then Kill TempFile
     
         ' Start Outlook
           Set olApp = CreateObject("Outlook.Application")
      
         ' Convert the Message worksheet into HTML
           With ActiveWorkbook.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=TempFile, _
             Sheet:=Wks.Name, _
             Source:=Rng.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
           End With
       
         ' Read the HTML file back as a string
           Set FSO = CreateObject("Scripting.FileSystemObject")
           Set HTMLfile = FSO.OpenTextFile(TempFile, ForReading, True, UseDefault)
           
            ' Read in the entire file as a string
              HTMLcode = HTMLfile.ReadAll
             
           HTMLfile.Close
          
          
         ' Re-align the HTML code to the left side of the page
           HTMLcode = Replace(HTMLcode, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
                      
         ' Compose and send the email
           Set olEmail = olApp.CreateItem(olMailItem)
             With olEmail
               .To = strto
               .Subject = "Analytical results"
               .BodyFormat = olFormatHTML
               .HTMLBody = strbody & HTMLcode
               .Display
             End With
                  
CleanUp:
   ' Did an error occur
     If Err <> 0 Then
        MsgBox "Run-time error '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description
     End If
   
   ' Close the new workbook and don't save it
     ActiveWorkbook.Close SaveChanges:=False
  
   ' Delete the Temp File
     If Dir(TempFile) <> "" Then Kill TempFile
   
   ' Delete the Publish Object
     With ActiveWorkbook.PublishObjects
       If .Count <> 0 Then .Item(.Count).Delete
     End With
   
   ' Free memory resources
     Set olApp = Nothing
     Set olEmail = Nothing
     Set FSO = Nothing

End Sub
Sub Better_Email()
  
  Dim Rng As Range
   'Set Rng = ThisWorkbook.Worksheets("Results").Range("A1:J39")
    EmailRangeInHTML "louis.proton@test.com", "This is a test"
  
End Sub

In hope

Protonspounge