Sub Email_Formats()
Dim wsTemplate As Worksheet: Set wsTemplate = Worksheets("Template (2)")
Dim iRowCount As Integer: iRowCount = wsTemplate.Range("H22").End(xlDown).Row
Dim a As Integer
Dim ws1 As Worksheet: Set ws1 = Worksheets("Macro Test")
Dim iRow1 As Integer, iRow2 As Integer, iRow3 As Integer, iRow4 As Integer, iRow5 As Integer
iRow1 = 250: iRow2 = 550: iRow3 = 950: iRow4 = 1250: iRow5 = 1500
For a = iRowCount To 2 Step -1
If wsTemplate.Range("AG" & a).Value = 1 Then
iRow1 = iRow1 + 1
wsTemplate.Range("C" & a & ":S" & a).Copy ws1.Range("A" & iRow1)
wsTemplate.Range("S" & a & ":S" & a).Copy ws1.Range("Q" & iRow1)
wsTemplate.Rows(a).EntireRow.Delete
ElseIf wsTemplate.Range("AG" & a).Value = 2 Then
iRow2 = iRow2 + 1
wsTemplate.Range("C" & a & ":S" & a).Copy ws1.Range("A" & iRow2)
wsTemplate.Range("S" & a & ":S" & a).Copy ws1.Range("Q" & iRow2)
wsTemplate.Rows(a).EntireRow.Delete
ElseIf wsTemplate.Range("AG" & a).Value = 3 Then
iRow3 = iRow3 + 1
wsTemplate.Range("C" & a & ":S" & a).Copy ws1.Range("A" & iRow3)
wsTemplate.Range("S" & a & ":S" & a).Copy ws1.Range("Q" & iRow3)
wsTemplate.Rows(a).EntireRow.Delete
ElseIf wsTemplate.Range("AG" & a).Value = 4 Then
iRow4 = iRow4 + 1
wsTemplate.Range("C" & a & ":S" & a).Copy ws1.Range("A" & iRow4)
wsTemplate.Range("S" & a & ":S" & a).Copy ws1.Range("Q" & iRow4)
wsTemplate.Rows(a).EntireRow.Delete
ElseIf wsTemplate.Range("AG" & a).Value = 5 Then
iRow5 = iRow5 + 1
wsTemplate.Range("C" & a & ":S" & a).Copy ws1.Range("A" & iRow5)
wsTemplate.Range("S" & a & ":S" & a).Copy ws1.Range("Q" & iRow5)
wsTemplate.Rows(a).EntireRow.Delete
End If
Next a
' Once our data is on the page it is time to start manipulating it to turn it into the right for for the emails
'
Sheets("Priority Unique").Select
Range("F251").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection.Copy
Range("A1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro Test").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Range("A80").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A160").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Priority Unique").Delete
Sheets.Add().Name = "Priority Unique"
Range("F551").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sales Unique").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Name"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro Test").Select
Range("A350").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Range("A420").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sales Unique").Delete
Sheets.Add().Name = "Sales Unique"
Range("F951").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Deleted Unique").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Name"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro Test").Select
Range("A750").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Range("A820").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Deleted Unique").Delete
Sheets.Add().Name = "Deleted Unique"
Application.DisplayAlerts = True
End Sub
Bookmarks