[VBA] If Cell Contains Certain Text, then Search IF Range Empty, If Cell Contains Different Text, then expand the Range it Searches?

Jimmers

New Member
Joined
Jul 8, 2019
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hi all,

Long time Listener, First Time Caller, so please bare with me.

I am a VBA Novice, very much cobbling together my knowledge through various forums such as this. I have come to a bit of a sticking point with some code I am working on at the minute.

What I want to get out is, IF cell C7 contains a number (between 1-5) then it the code will check to see if any Cell in a Range is empty, and if it is Empty will Display a Message Box.

It is for a Matrix Submission Form that does this check and then submits an e-mail.

So if C7 Contains 1, then the Range it needs to check is C10:C13 and C15:C65
If C7 Contains 2, then the Range is C10:C13 and C15:C65, and E10:E13 and E15:E65
If C7 Contains 3, then the Range is C10:C13 and C15:C65, and E10:E13 and E15:E65 and G10:G13 and G15:G65

And follows this convention (I Would like to potentially be able to add additional ranges if we were to extend the SKU form etc.

The Code I Have currently is this (Highlighted in Red) then followed by the rest of my e-mail code;

Code:
[I]Sub EMail_Form()
'
' EMail Macro
''Sub Mail_ActiveSheet()


[COLOR=#ff0000]Dim cell As Range[/COLOR]
[COLOR=#ff0000]ActiveSheet.Select[/COLOR]
[COLOR=#ff0000]Range("C10:C14", "C15:C65").Select 'Change as required[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]For Each cell In Selection[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]If cell.Value = "" Then 'Change as required[/COLOR]
[COLOR=#ff0000]MsgBox "Cannot Submit SKU Matrix Without ALL Fields filled in, if you require information please look in Instructions Tab for where to get this information"[/COLOR]
[COLOR=#ff0000]Exit Sub[/COLOR]
[COLOR=#ff0000]Else[/COLOR]
[COLOR=#ff0000]End If[/COLOR]
Next
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    Set Sourcewb = ActiveWorkbook


    'Copy the ActiveSheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook


    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With


    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False


    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & ""
    TempFileName = Range("C2") & "-" & "Packaging Matrix"


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .to = ""
            .CC = ""
            .BCC = ""
            .Subject = Range("C2") & "-" & "Packaging Matrix"
            .HTMLbody = "******>[/I][I]Hi[/I]
[I]Please find attached Packaging Matrix[/I]
[I]" _
     & "[/I][I]Any queries please let me know[/I]
[I]Regards[/I]
[I]"
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With


    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr


    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    With ActiveWorkbook
    Application.DisplayAlerts = True
    
    MsgBox "Your Request Has Now Been Submitted"
    With ActiveWorkbook
        .Save
        End With
    Application.DisplayAlerts = True
End With
End Sub


[/I]
​Any help will be appreciated, and thank you in advance.
 
Last edited by a moderator:

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
welcome to the board

don't use activate, select, selection etc., learn to work with distinct objects

In this case, instead of creating a Selection object and working with that, create a Range object that you can use

Code:
Dim rngToCheck As Range
Select Case Range("C7")
    Case 1
        Set rngToCheck = Range("C10:C13, C15:C65")
    Case 2
        Set rngToCheck = Range("C10:C13, C15:C65, E10:E13, E15:E65")
    Case 3
        Set rngToCheck = Range("C10:C13, C15:C65, E10:E13, E15:E65, G10:G13, G15:G65")
End Select

for each cell in rngToCheck
Now you can work with rngToCheck instead of Selection. Note how I've had to SET the object, as I'm creating the range object not just assigning a value to it
 
Last edited:
Upvote 0
Thanks for the assistance baitmaster, that has worked perfectly.

Just for my learning, regarding activate, select etc. whats the downfalls to using these?

Also are you aware of any code I could put into the sheet to allow you to block it from being e-mailed directly (ideally I want to only allow the sheet to be e-mailed by using the e-mail macro)
 
Upvote 0
Activate, Select, etc are simply unnecessary. The extra programming steps add complication to your code, are a primary cause of slowing your code down, looks ugly when running, introduces the potential for errors, is less versatile etc...

They exist primarily from where you have recorded a macro, and the recorder captures EVERY move you make, including scrolling, selecting, changing sheet etc. Their purpose is to create an Object that you can work with, such as Activecell, Activesheet, Activewindow or Selection

Look at your code, you will see the whole thing is built on the premise of Object.Property and Object.Method where Object = the thing you are working with, Property = some information about the thing, and Method = something you can do to the thing. So where you write
Code:
Range("A1").Select
Selection.Value = "some text"
You have a range object to which you are applying the Select method, in order to create the Selection object. You then have a Selection object (which is itself a range object) and are changing the Value property. I would simply write
Code:
Range("A1").Value = "some text"
. I still have an object and am changing it's property - but I can declare my object at the start of the code, open/close/create other workbooks, be on other pages when running the code... and my code will still work. Yours requires you to constantly change windows, worksheets, decide whether another window was activated or not - and will still probably go wrong in some circumstances. Keep it simple.

There is no code you could add that would prevent someone from simply emailing the worksheet or the workbook, sorry. You could consider a piece of code that checks the file location when it opens and forces the file to close if the settings are wrong, but I'd simply seek to educate my Users instead

HTH
 
Upvote 0
Thanks very much for all the help, makes perfect sense.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,998
Members
448,539
Latest member
alex78

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