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;
Any help will be appreciated, and thank you in advance.
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]
Last edited by a moderator: