VBA for verifying whether a specific worksheet and cell have data or not

willow1985

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
915
Office Version
  1. 365
Platform
  1. Windows
Hello,

I believe I am looking for a very simple VBA code but am not sure because of how my current Macro is structured.

During one point while my macro is running it checks a certain cell (B16) and if it is blank it will issue a message, "No Results" and will end sub. If there is results it will run the rest of the code.

Now that being said I would like to run one more check in this macro whether B16 is blank or not.

I would like it to check if a specific cell on a specific sheet (A2, sheet: "wk 53) is blank and if not issue this message as the final message before the Macro stops running:

Msg: "There is a carry over year end date. Check Tab: wk 53 for additional reprocess data".

See my complete code below if required:

Code: 
Sub Update()'
' Update Macro
'


'
    
        Sheets("A&R Report").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
Sheets("Headers").Visible = True
Sheets("CY").Visible = True
Sheets("Report").Visible = True
Sheets("DATA").Visible = True


    Sheets("DATA").Select
    Cells.Select
    Selection.Copy
    Sheets("Report").Select
        Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Columns("W:W").Select
    Selection.Replace What:="1", Replacement:="Additional", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="2", Replacement:="Reprocess", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Sheets("Weekly Reprocess").Select
    Rows("16:100000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A16:A100000").Select
    Selection.ClearContents
    Range("A16").Select
    Sheets("CY").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheets("wk 53").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheets("Headers").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    Sheets("Report").Select
            Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
                    Columns("O:O").Select
    Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
            Columns("G:G").Select
    Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
    Cells.Select
    Selection.Copy
    Sheets("CY").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Debug.Print Now(), 'NEW SECTION'


    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:T").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.ClearContents
    Columns("C:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.Copy
    Columns("C:C").Select
    ActiveSheet.Paste
    Range("D1").Select
    ActiveSheet.Paste
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Copy
    Range("D1").Select
    ActiveSheet.Paste
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Copy
    Range("E1").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("M:M").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("M:M").Select
    Selection.Copy
    Range("I1").Select
    ActiveSheet.Paste
    Columns("M:M").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Date In-Out"
     LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("Q2:Q" & LastRowColumnA).Formula = "=IF(COUNT(RC[-3]:RC[-2])<>2,"""",TEXT(RC[-3],""mmm dd"")&"" - ""&TEXT(RC[-2],""mmm dd""))"
    Columns("Q:Q").Select
    Selection.Copy
    Range("H1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Q:Q").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "#W/O has been Reprocessed"
     LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("Q2:Q" & LastRowColumnA).Formula = "=COUNTIF(C[-16],RC[-16])"
    Columns("Q:Q").Select
    Selection.Copy
    Range("K1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Q:Q").Select
    Application.CutCopyMode = False
    Selection.ClearContents
Columns("N:O").Select
    Range("O1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Year"
    Range("O2").Select
         LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("O2:O" & LastRowColumnA).Formula = "=YEAR(RC[-13])"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Y/N"
     LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("P2:P" & LastRowColumnA).Formula = "=IFERROR(INDEX('Weekly Reprocess'!R2C18,MATCH('Weekly Reprocess'!R2C17,RC[-1],FALSE)),""No"")"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Week#"
         LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("Q2:Q" & LastRowColumnA).Formula = "=WEEKNUM(RC[-15],2)"
   Range("R1").Select
    ActiveCell.FormulaR1C1 = "Yes/No"
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("R2:R" & LastRowColumnA).Formula = "=IFERROR(INDEX('Weekly Reprocess'!R2C15,MATCH('Weekly Reprocess'!R2C14,RC[-1],FALSE)),""No"")"
    Columns("O:R").Select
    Selection.Copy
    Range("S1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("O:R").Select
    Range("R1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    
 Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=15, Criteria1:="Yes"
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=16, Criteria1:="53"
    Range("A1:P1000000").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("wk 53").Select
    ActiveSheet.Paste
    Columns("O:O").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("CY").Select
    
ActiveSheet.ShowAllData
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=15, Criteria1:="Yes"
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=17, Criteria1:="Yes"
    Selection.SpecialCells(xlCellTypeVisible).Select
    Range("A1:Q1000000").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("A&R Report").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("C:C").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.RowHeight = 30
    Columns("K:K").ColumnWidth = 15.29
    Columns("K:K").ColumnWidth = 13.86
    Columns("L:L").ColumnWidth = 62.29
    Columns("L:L").ColumnWidth = 50.14
    Columns("L:L").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
    Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Range("A1").Select
    
    Sheets("CY").Select
    ActiveSheet.ShowAllData
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=13, Criteria1:= _
        "Reprocess"
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=15, Criteria1:="Yes"
    ActiveSheet.Range("$A$1:$AT$1000000").AutoFilter Field:=17, Criteria1:="Yes"
    Range("A1:L1000000").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Headers").Select
    Range("A1").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1:L1000000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Weekly Reprocess").Select
    Range("B16").Select
    ActiveSheet.Paste
    Sheets("Headers").Select
    Range("D1:D1000000").Select
    Selection.Copy
    Range("W1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$W$1:$W$1000000").RemoveDuplicates Columns:=1, Header:=xlNo
    Selection.Copy
    Sheets("Weekly Reprocess").Select
    Range("R8").Select
    ActiveSheet.Paste


    Sheets("Headers").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    
    Sheets("Weekly Reprocess").Select
    Range("B16").Select
    
     If Range("B16") <> "" Then
   Msg = "Update Complete"
   
   Range("A15:M1000000").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:M1000000")
        .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").CurrentRegion.Select
Range("A16", Cells(Rows.Count, 1).End(xlUp)).Resize(, 13).Select


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
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("B16").CurrentRegion.Select
Range("B16", Cells(Rows.Count, 1).End(xlUp)).Resize(, 13).Select
    ActiveWorkbook.Worksheets("Weekly Reprocess").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Weekly Reprocess").Sort.SortFields.Add2 Key:=Range _
        ("C16:C1000000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Weekly Reprocess").Sort
        .SetRange Range("B15:M1000000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
Debug.Print Now(), 'CLEAR DATA RECORDS'


End If
    Columns("I:I").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("M:M").ColumnWidth = 43.14
    Columns("K:K").EntireColumn.AutoFit
    Rows("15:1000000").Select
    Rows("15:1000000").EntireRow.AutoFit
   
   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("A&R Report").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
   






If Msg = "" Then Msg = "No Results"
MsgBox Msg




End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Add this code immediately above the End Sub statement

Code: 
If Worksheets("wk 53").Range("A2").Value <> vbNullString Then
    MsgBox "There is a carry over year end date. Check Tab: wk 53 for additional reprocess data"
End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
433
CapRavOr
C
N
  • Question Question
Adding to an existing MACRO
Replies
2
Views
98
Northern NY Design
N
S
  • Question Question
Macro Formatting to all WS
Replies
4
Views
285
MARK858
MARK858
M
  • Question Question
How To Loop Macro
Replies
6
Views
459
rlv01
R

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

Share this page

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