willow1985
Well-known Member
- Joined
- Jul 24, 2019
- Messages
- 915
- Office Version
- 365
- Platform
- Windows
Hello I have the below code (I am only providing the bottom half of the code as it is long). What I would like to do is where I left the first gap in the code I want the macro to check if Cell B16 is blank on sheet: "weekly process", if yes I want it to skip to the next blank and run from there but issue a different message box at the end (instread of update complete it would say no results). Can this be done?
Thank you for all of your help
Carla
Code:
Cells.Select
lastCol = ActiveSheet.Range("a1").End(xlToRight).Column
Lastrow = ActiveSheet.Cells(1, 1).End(xlDown).Row
Selection.AutoFilter
ActiveSheet.Range("A1", ActiveSheet.Cells(Lastrow, lastCol)).AutoFilter Field:=12, Criteria1:="No"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Sheets("Headers").Select
Rows("1:1").Select
Selection.Copy
Sheets("CY").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Sheets("CY").Select
Range("A2:H1000000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Reprocess").Select
Range("B16").Select
ActiveSheet.Paste
****check if B16 is blank, if no continue, if yes skip ahead*******
Range("A15:I1000000").Select
ActiveWorkbook.Worksheets("Weekly Reprocess").Sort.SortFields.Add Key:=Range( _
"B16:B1000000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Weekly Reprocess").Sort
.SetRange Range("A15:I1000000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A16").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
If Cells(Rows.Count, "B").End(xlUp).Row > 16 Then
Range("A16").AutoFill Destination:=Range("A16:A" & Cells(Rows.Count, "B").End(xlUp).Row), Type:=xlFillSeries
End If
Range("A16").Select
Range("A16", Range("A16").End(xlDown).End(xlToRight)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
******Cell B16 was blank, continue from here*******
Range("A15").Select
Application.DisplayAlerts = False
Sheets("Report").Select
ActiveWindow.SelectedSheets.Delete
Sheets.Add().Name = "Report"
Application.DisplayAlerts = True
Sheets("Report").Sort.SortFields.Clear
Sheets("CY").Sort.SortFields.Clear
Sheets("DATA").Sort.SortFields.Clear
Sheets("Weekly Reprocess").Sort.SortFields.Clear
Sheets("wk 53").Sort.SortFields.Clear
Sheets("Headers").Sort.SortFields.Clear
Sheets("Headers").Visible = False
Sheets("CY").Visible = False
Sheets("Report").Visible = False
Sheets("DATA").Visible = False
Sheets("Weekly Reprocess").Select
Range("A1").Select
MsgBox "Update Complete" *********Different message box "No Results"************
End SubThank you for all of your help
Carla
Last edited by a moderator:
