Issue with excel vba range

Question

I'm lost a bit..

I have an excel sheet which uses this function (original, written by Ron de Bruin):

'===================================================================================
'           FUNCTION FOR SENDING RANGE AS HTML IN EMAIL (DO NOT EDIT THIS)
'===================================================================================

Function RangetoHTML(rng As Range)

' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016 web: https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy

    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select

        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

 

  'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

and the following sub:

'===================================================================================
'                                   EMAILS
'===================================================================================

Sub email_sender()

Dim objOutApp As Object, objOutMail As Object
Dim strBody As String, strSig As String
 
 'FOR SENDING BODY AS RANGE

Dim rng As Range
Set rng = Nothing
Dim isToday As String
isToday = Format(Date, "dddd")
Dim wb As Workbook: Set wb = ThisWorkbook
Sheet1.Activate

Select Case isToday
   Case "Monday"
      Set rng = wb.Sheets(1).Range("A2:AC44").SpecialCells(xlCellTypeVisible)

   Case "Tuesday"
      Set rng = wb.Sheets(1).Range("AE2:BG44").SpecialCells(xlCellTypeVisible)

   Case "Wednesday"
      Set rng = wb.Sheets(1).Range("BI2:CK44").SpecialCells(xlCellTypeVisible)
   
   Case "Thursday"
      Set rng = wb.Sheets(1).Range("CM2:DO44").SpecialCells(xlCellTypeVisible)
 
   Case "Friday"
      Set rng = wb.Sheets(1).Range("DQ2:ES44").SpecialCells(xlCellTypeVisible)

   Case "Saturday"
    MsgBox "Weekend, take a break.."

    Exit Sub

   Case "Sunday"
    MsgBox "Weekend, take a break.."
    Exit Sub
End Select

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

Issue: Does not work on my colleagues computer, receives the latter error "The selection is not a range or the sheet is protected" But, it works perfectly on my PC.

I have tried to fix this with adding:

Dim wb As Workbook: Set wb = ThisWorkbook
Sheet1.Activate

But it did not help.. I just can't figure it out, since it works perfectly on my pc..

Any ideas how to solve it?

Answer 1

This would be more robust:

    Dim dayNum As Long
     
    dayNum = Weekday(Date, vbMonday) 'Monday = day 1
    If dayNum < 6 Then
        Set rng = wb.Sheets(1).Range("A2:AC44"). _
                  Offset(0, (dayNum - 1) * 30).SpecialCells(xlCellTypeVisible)
    Else
        MsgBox "Weekend, take a break.."
    End If