Using a Dynamic VBA Thread in a macro

CBROWN1

New Member
Joined
Sep 28, 2009
Messages
43
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.

VBA Code:
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.

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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:
VBA Code:
Sub Submit()
    If DynamicRange.Interior.ColorIndex = xlColorIndexNone Then
    '
    '

Your custom function:
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,541
Latest member
iparraguirre89

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