Using a Dynamic VBA Thread in a macro

[CBROWN1]

Hi Experts!

I have created a form that users need to fill in before submitting for review. If the necessary fields are not completed the row in the table will be highlighted in colour. In order to submit the form the user will select a button that runs a macro. The macro will check if there are any highlighted cells in the range and if there are a msg box will pop up asking the user to review and try again. If the cells are clear of colour the macro will proceed to attach the file to an email and submit it for review. The problem i have is that my range needs to be dynamic as I never know how many rows a user will need. I have written code to identify what the range is but I'm unsure how to call it with the sendemail macro.

My dynamic range code is

Sub DynamicRange()

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = Worksheets("Sheet1")
Set StartCell = Range("B9")

'Find Last Row and Column
  LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

'Select Range
  sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select

End Sub

And my send email macro is where XXX needs to be the dynamic range found above.

Sub Submit()


If Range([COLOR=rgb(209, 72, 65)]XXX[/COLOR]).Interior.ColorIndex = xlColorIndexNone Then
    
        Filename = InputBox("Please provide a name for this request")
      
        ThisWorkbook.SaveAs (Environ("userprofile") & Application.PathSeparator & "Desktop" & Application.PathSeparator & Filename)
      
        Dim myOutlook As Object
      
        Dim myMailitem As Object
      
        Set otlApp = CreateObject("Outlook.Application")
        Set otlnewmail = otlApp.CreateItem(olMailItem)
        fname = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
      
        With otlnewmail
      
        .To = Cells(2, 3)
        .Subject = "Project " & Filename
        .Body = "Please review the attached request and approve / reject"
        .Attachments.Add fname
        .Display
      
      
        End With
      
        Set otlnewmail = Nothing
        Set otlApp = Nothing
        Set otlAttach = Nothing
        Set otlMess = Nothing
        Set otlNSpace = Nothing

Else


    MsgBox "Please note all highlighted fields must be completed before you can submit for approval. Please review and try again."

End If
End Sub

 

[GWteB]

You could change the SUB procedure into a FUNCTION procedure that returns the range. You then only have to change the first line of the submit procedure:

Sub Submit()
    If DynamicRange.Interior.ColorIndex = xlColorIndexNone Then
    '
    '

Your custom function:

Public Function DynamicRange() As Range

    Dim LastRow     As Long
    Dim LastColumn  As Long
    Dim StartCell   As Range

    Set StartCell = Worksheets("Sheet1").Range("B9")

    With StartCell.Parent
        'Find Last Row and Column
        LastRow = .Cells(.Rows.Count, StartCell.Column).End(xlUp).Row
        LastColumn = .Cells(StartCell.Row, .Columns.Count).End(xlToLeft).Column

        'determine Range
        Set DynamicRange = .Range(StartCell, .Cells(LastRow, LastColumn))
    End With
End Function