Run Submacro If It Contains Data

I have what I am sure is a very simple problem that is likely to have an equally simple solution.

I have a workbook ("Triage.xlsm") that has four worksheets named “Data1”, “Data2”, “Data3” and “Data4”. At the moment I have a declared variable which gets utilised in various submacros which I am sure will also be required to answer my query.

Code:

---

Dim ws As Worksheet

---

There is a submacro called “Markers” that will need to be run on “Data1” or “Data3” if either of them contains data. There are occasions when only “Data1” will contain data, so obviously the submacro needs to only be run on “Data1”. I'd also need it to tell the user if both "Data1" and "Data3" contains no data.

I’m certain that some sort of error checking needs to take place but cannot fathom out how to do the above.

Help will be very much appreciated.

Many thanks!

Some ideas

1. Not 'error checking' but more 'validity checking' -- IMHO it's better to prevent an error than to try and recover from one

2. I prefer to avoid global variables as much as possible (Dim ws as Worksheet) and pass such things as a calling parameter (Call Markers(ws))

3. You never defined what 'no data' means, so I went with a completely blank worksheet -- you may have to change that

Code:

---

Option Explicit


Dim ws As Worksheet


Sub Main()
    Dim i As Long
   
    For i = 1 To 4
        Set ws = Worksheets("Data" & i)
        Call Markers(ws)
    Next


End Sub


Sub Markers(sht As Worksheet)
    Dim M As Double
   
    M = sht.Rows.Count  '  avoid overflow
    M = M * sht.Columns.Count
   
    If Application.WorksheetFunction.CountBlank(sht.Cells) = M Then
        MsgBox ws.Name & " is empty"
        Exit Sub
    End If
   
    MsgBox "Doing stuff on " & ws.Name
End Sub

---

Quote:

---

I have what I am sure is a very simple problem that is likely to have an equally simple solution.

---

How do you know ?

Quote:

---

Originally Posted by Paul_Hossler

Some ideas

1. Not 'error checking' but more 'validity checking' -- IMHO it's better to prevent an error than to try and recover from one

2. I prefer to avoid global variables as much as possible (Dim ws as Worksheet) and pass such things as a calling parameter (Call Markers(ws))

3. You never defined what 'no data' means, so I went with a completely blank worksheet -- you may have to change that

Code:

---

Option Explicit


Dim ws As Worksheet


Sub Main()
    Dim i As Long
   
    For i = 1 To 4
        Set ws = Worksheets("Data" & i)
        Call Markers(ws)
    Next


End Sub


Sub Markers(sht As Worksheet)
    Dim M As Double
   
    M = sht.Rows.Count  '  avoid overflow
    M = M * sht.Columns.Count
   
    If Application.WorksheetFunction.CountBlank(sht.Cells) = M Then
        MsgBox ws.Name & " is empty"
        Exit Sub
    End If
   
    MsgBox "Doing stuff on " & ws.Name
End Sub

---

---

Many thanks for this Paul, but as suggested by snb, this was not quite as simple! :(

I think that I need to provide all the code for my "project"!

I'm still a novice at VBA so am probably commiting some programming problems for myself along the way.

I tried to "manipulate" the code you supplied to fit my requirements and failed miserably.

Hopefully, I've managed to attach my form along with some "dummy" data.

I really do appreciate your help!

I've already spotted a glaring error in this sub. I'd still really appreciate some help please. Thanks!

Code:

---

Private Sub cmdSORHistory_Click()

    ' Run formatting on History1 and History2 if they contain data


    'Dim i    As Long

    For i = 1 To 2
        Set ws = Worksheets("SOR_History" & i)
       
    Next
   
    Dim M As Double
   
    M = ws.Rows.Count                            '  avoid overflow
    M = M * ws.Columns.Count
   
    If Application.WorksheetFunction.CountBlank(ws.Cells) = M Then
        MsgBox ws.name & " is empty"
        '        Exit Sub
    End If
   
   
    ' Delete any row containing the words 'Z INFORMATION SHARING' in column D
    'Dim i    As Long
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If InStr(Cells(i, 4), "Z INFORMATION SHARING") Then
            'If InStr(Cells(i, 4), "Z INFORMATION SHARING") Or InStr(Cells(i, 4), "Abcdef") Then
            Rows(i).Delete
        End If
    Next
   
    ' Perform the basic editing
   
    ' Delete first column
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
   
    ' Find and remove all instances of ' [O]'
    Columns("B:B").Select
    Selection.Replace What:=" [O]", Replacement:="", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
   
    ' Format date column
    Range("$D:$D").NumberFormat = "dd/mm/yyyy"
   
    ' Delete columns and rows not required
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-1
    Rows("1:3").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
   
    ' Delete all rows with a date older than eighteen months
    Application.ScreenUpdating = False
    ActiveSheet.AutoFilterMode = False
    Dim FilterRange As Range, myDate As Date
    myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
    Set FilterRange = _
        Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
    FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
    On Error Resume Next
    With FilterRange
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
    End With
    Err.Clear
    Set FilterRange = Nothing
    ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
   
    ' Add row to top of worksheet
    Range("$A$1").EntireRow.Insert
   
    ' Add line of text
    ActiveSheet.Range("A1").Value = "This is the history shown for the past eighteen months :-" & vbCrLf
   
    'End If
    'Next ws
   
    ' Message box to show formatting SORHistory complete
    Dim answer As Integer
   
    answer = MsgBox("Formatting of SOR History Complete", vbInformation + vbOKOnly, "Triage Hub")
    Application.ScreenUpdating = True
End Sub

---

Avoid Application.WorksheetFunction, Application alone suffices.
Avoid 'Select' and 'Activate' in VBA.

Thanks, snb - as per advice I've removed these "words".

Still having an issue with checking the two "pairs" of worksheets for data.

One sub needs to check "Warning_Markers1" and "Warning_Markers2" to see if they contain any data. If either do then the rest of the sub needs to run.
The other sub needs to check "SOR_History1" and "SOR_History2" to see if they contain data, then as above, the rest of the sub needs to run.

The worksheets will either contain data "similar" to the template or be completely empty.

The subs "cmdWarning_Markers" and "cmdSOR_History" are the only two that don't work.

Thanks again!

No wonder if procedures like 'Warning_Markers' are lacking.

Code:

---

Private Sub UserForm_Initialize()
  For Each it In Sheets
            c00 = c00 & " " & it.name
  Next

      ListBox1.List = Split(Trim(c00))
End Sub

---

Sorry, snb, I'm not completely understanding. I get that my subs have a different name and your code is to try and address this, but I get a compile error: variable not defined on "it".

Code:

---

' Toggle height of the userform

Private Sub UserForm_Initialize()
For Each it In Sheets
            c00 = c00 & " " & it.name
  Next

      ListBox1.List = Split(Trim(c00))
    Dim sht
    dHeight = Me.Height
    For Each sht In ThisWorkbook.Sheets
        Me.ListBox1.AddItem sht.name
    Next sht
End Sub

---

I've gone with a slightly different approach and am concentrating on just one sub -

Code:

---

Private Sub cmdWarning_Markers_Click()

    Dim Firstcolumn As Long, Lastcolumn As Long, Lcolumn As Long, CalcMode As Long, ViewMode As Long

    For Each ws In Worksheets
        If ws.name Like "Warning_Markers*" Then
           
            Dim M As Double
           
            M = ws.Rows.Count '  avoid overflow
            M = M * ws.Columns.Count
           
            If Application.CountBlank(ws.Cells) = M Then
                MsgBox ws.name & " is empty"
            End If
           
        Else
           
            ' -------------------------------------------------------
            ' Check for cells in column D that contain the word 'To'
            ' If any cells do then delete column D
            With Application
                CalcMode = .Calculation
                .Calculation = xlCalculationManual
                .ScreenUpdating = False
            End With
           
            'We use the ActiveSheet but you can replace this with
            'Sheets("MySheet")if you want
            With ActiveSheet
               
                'If you are in Page Break Preview Or Page Layout view go
                'back to normal view, we do this for speed
                ViewMode = ActiveWindow.View
                ActiveWindow.View = xlNormalView
               
                'Turn off Page Breaks - we do this for speed
                .DisplayPageBreaks = False
               
                ' Set the first and last column to loop through
               
                Firstcolumn = 3
                Lastcolumn = 5
               
                ' We loop from Lastcolumn to Firstcolumn (right to left)
                For Lcolumn = Lastcolumn To Firstcolumn Step -1
                   
                    ' We check the values in the D column in this example
                    With Cells(Lcolumn, "D")
                       
                        If Not IsError(.Value) Then
                           
                            ' This will delete each row with the Value "To"
                            ' in Column D (not case sensitive)
                            If LCase(.Value) = LCase("To") Then .EntireColumn.Delete
                           
                        End If
                       
                    End With
                   
                Next Lcolumn
            End With
           
            ActiveWindow.View = ViewMode
            With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
            ' -------------------------------------------------------
            ' Format date in column C
            Range("$C:$C").NumberFormat = "dd/mm/yyyy"
           
            ' Delete first three rows
            Rows("1:3").Delete
            ' -------------------------------------------------------
            ' Sort Warning Markers, firstly by values in array, then by date order
            Dim rData      As Range, rData1 As Range, rData2 As Range
            Dim r          As Long, i As Long, iLastSort As String
            Dim arySorts  As Variant
            Dim sLastSort  As String
           
            arySorts = Array("Domestic abuse/violence", "Violent", "Weapons", "Drugs", "Offends on bail") ' starts at 0
           
            Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
            Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
           
            Application.AddCustomList ListArray:=arySorts
           
            With ActiveSheet.Sort
                .SortFields.Clear
                .SortFields.Add Key:=rData1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=Application.CustomListCount
                .SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                .SetRange rData
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
                .SortFields.Clear
            End With
           
            Set rData2 = Nothing
            With rData
               
                'see which last sort is in data
                For i = UBound(arySorts) To LBound(arySorts) Step -1
                    iLastSort = -1
                    On Error Resume Next
                    iLastSort = Application.WorksheetFunction.Match(arySorts(i), Application.WorksheetFunction.Index(rData, 0, 2), 0)
                    On Error GoTo 0
                   
                    'found custom sort value
                    If iLastSort > -1 Then
                        sLastSort = LCase(arySorts(i))
                        Exit For
                    End If
                Next i
            End With
           
            'custom sort value found
            If Len(sLastSort) > 0 Then
               
                With rData
                    For r = .Rows.Count To 3 Step -1
                        If LCase(.Cells(r, 2).Value) = sLastSort Then
                            Set rData2 = .Cells(r + 1, 1)
                            Set rData2 = Range(rData2, rData2.End(xlDown).End(xlToRight))
                            Exit For
                        End If
                    Next
                End With
               
                'MsgBox rData2.Address
                With ActiveSheet.Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                    .SetRange rData2
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                    .SortFields.Clear
                End With
               
            End If
           
            Application.DeleteCustomList ListNum:=Application.CustomListCount
            ' -------------------------------------------------------
            ' Delete first column
            Columns(1).Delete
           
            ' Add row to top of worksheet
            Range("$A$1").EntireRow.Insert
           
            With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
           
            ' Add line of text to cell A1
            ActiveSheet.Range("A1").Value = "These are the warning markers shown :-" & vbCrLf
           
            ' Message box to show formatting complete
            Dim answer As Integer
           
            answer = MsgBox("Formatting of Warning Markers Complete", vbInformation + vbOKOnly, "Triage Hub")
            Application.ScreenUpdating = True
           
        End If
    Next ws
lbl_Exit:
    Exit Sub
End Sub

---

If I have data in Warning_Markers1, then it formats okay and puts up the message box to tell me that Warning_Markers2 is empty, but then when I click okay, it immediately shows an error on this line with Runtime error 91: Object variable or With block variable not set.

If I have data in Warning_Markers1 and Warning_Markers2, then it goes straight to the same line and error.

Code:

---

.SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending

---

Solved the warnings!

Everything works okay, except for when there is no data in Warning_Markers1, but there is data in Warning_Markers2.

Code:

---

Private Sub cmdWarning_Markers_Click()

    Dim CalcMode As Long, ViewMode As Long

    For Each ws In Worksheets
        If ws.name Like "Warning_Markers*" Then
           
            Dim M As Double
           
            M = ws.Rows.Count '  avoid overflow
            M = M * ws.Columns.Count
           
            If Application.CountBlank(ws.Cells) = M Then
                MsgBox ws.name & " is empty"
               
                Exit Sub
            End If
           
        Else
           
            ' -------------------------------------------------------
            ' Check for cells in row A that contain the word 'To'
            ' If any cells do then delete that column
            With Application
                CalcMode = .Calculation
                .Calculation = xlCalculationManual
                .ScreenUpdating = False
            End With
           
            'Using ActiveSheet but can replace this with
            'Sheets("MySheet")if you want
            With ActiveSheet
               
                'If you are in Page Break Preview Or Page Layout view go
                'back to normal view, we do this for speed
                ViewMode = ActiveWindow.View
                ActiveWindow.View = xlNormalView
               
                'Turn off Page Breaks - we do this for speed
                .DisplayPageBreaks = False
               
                Dim A As Range
               
                Do
                    Set A = Rows(1).Find(What:="To", LookIn:=xlValues, lookat:=xlPart)
                    If A Is Nothing Then Exit Do
                    A.EntireColumn.Delete
                Loop
               
            End With
           
            ActiveWindow.View = ViewMode
            With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
            ' -------------------------------------------------------
            ' Format date in column C
            Range("$C:$C").NumberFormat = "dd/mm/yyyy"
           
            ' Delete first three rows
            Rows("1:3").Delete
            ' -------------------------------------------------------
            ' Sort Warning Markers, firstly by values in array, then by date order
            Dim rData      As Range, rData1 As Range, rData2 As Range
            Dim r          As Long, i As Long, iLastSort As String
            Dim arySorts  As Variant
            Dim sLastSort  As String
           
            arySorts = Array("Domestic abuse/violence", "Violent", "Weapons", "Drugs", "Offends on bail") ' starts at 0
           
            Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
            Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
           
            Application.AddCustomList ListArray:=arySorts
           
            With ActiveSheet.Sort
                .SortFields.Clear
                .SortFields.Add Key:=rData1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=Application.CustomListCount
                .SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                .SetRange rData
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
                .SortFields.Clear
            End With
           
            Set rData2 = Nothing
            With rData
               
                'see which last sort is in data
                For i = UBound(arySorts) To LBound(arySorts) Step -1
                    iLastSort = -1
                    On Error Resume Next
                    iLastSort = Application.WorksheetFunction.Match(arySorts(i), Application.WorksheetFunction.Index(rData, 0, 2), 0)
                    On Error GoTo 0
                   
                    'found custom sort value
                    If iLastSort > -1 Then
                        sLastSort = LCase(arySorts(i))
                        Exit For
                    End If
                Next i
            End With
           
            'custom sort value found
            If Len(sLastSort) > 0 Then
               
                With rData
                    For r = .Rows.Count To 3 Step -1
                        If LCase(.Cells(r, 2).Value) = sLastSort Then
                            Set rData2 = .Cells(r + 1, 1)
                            Set rData2 = Range(rData2, rData2.End(xlDown).End(xlToRight))
                            Exit For
                        End If
                    Next
                End With
               
                'MsgBox rData2.Address
                With ActiveSheet.Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                    .SetRange rData2
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                    .SortFields.Clear
                End With
               
            End If
           
            Application.DeleteCustomList ListNum:=Application.CustomListCount
            ' -------------------------------------------------------
            ' Delete first column
            Columns(1).Delete
           
            ' Add row to top of worksheet
            Range("$A$1").EntireRow.Insert
           
            With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
           
            ' Add line of text to cell A1
            ActiveSheet.Range("A1").Value = "These are the warning markers shown :-" & vbCrLf
           
            ' Message box to show formatting complete
            Dim answer As Integer
           
            answer = MsgBox("Formatting of Warning Markers Complete", vbInformation + vbOKOnly, "Triage Hub")
            Application.ScreenUpdating = True
           
        End If
    Next ws
lbl_Exit:
    Exit Sub
End Sub

---

This is ridiculous code:

Code:

---

If ws.name Like "Warning_Markers*" Then
 Dim M As Double
 M = ws.Rows.Count '  avoid overflow
 M = M * ws.Columns.Count
 If Application.CountBlank(ws.Cells) = M Then
  MsgBox ws.name & " is empty"
  Exit Sub
 End If

---

You should replace it by

Code:

---

If ws.usedrange.address <>"$A$1" Then

---

I'm still learning so I do not know what this is supposed to replace or achieve.

I've changed my code to this, but this is not working. If this is checking the first cell then it won't work as any data being processed will have nothing in that cell.

Code:

---

Private Sub cmdWarning_Markers_Click()

    Dim CalcMode As Long, ViewMode As Long

    For Each ws In Worksheets
        If ws.name Like "Warning_Markers*" Then
           
            If ws.UsedRange.Address <> "$A$1" Then
                MsgBox ws.name & " is empty"
               
                Exit Sub
            End If
           
        Else

---

If you want to learn start with this first: Excel VBA Programming For Dummies by John Walkenbach | 9781119077398 | Paperback | Barnes & Noble

I've nearly got this working as it should.

If there is no data in "Warning_Markers1" and "Warning_Markers2", then the message box shows this.

If there is data in "Warning_Markers1" and none in "Warning_Markers2", this runs the rest of the sub correctly.

If there is data in "Warning_Markers1" and "Warning_Markers2", then only the data in "Warning_Markers2" is processed by the sub. Running the sub again will then process the data in "Warning_Markers2".

If there is no data in "Warning_Markers1", but there is in "Warning_Markers2" then running the sub, the message box states that there is nothing in "Warning_Markers1" but ignores "Warning_Markers2".

I really need to get this working.

Code:

---

Private Sub cmdWarning_Markers_Click()

    Dim CalcMode As Long, ViewMode As Long

    For Each ws In Worksheets
        If ws.name Like "Warning_Markers*" Then
           
            If WorksheetFunction.CountA(Cells) = 0 Then
                MsgBox ws.name & " is empty"
               
                Exit Sub
            End If
        Else
           
            ' -------------------------------------------------------
            ' Check for cells in row A that contain the word 'To'
            ' If any cells do then delete that column
            With Application
                CalcMode = .Calculation
                .Calculation = xlCalculationManual
                .ScreenUpdating = False
            End With
           
            'Using ActiveSheet but can replace this with
            'Sheets("MySheet")if you want
            With ActiveSheet
               
                'If you are in Page Break Preview Or Page Layout view go
                'back to normal view, we do this for speed
                ViewMode = ActiveWindow.View
                ActiveWindow.View = xlNormalView
               
                'Turn off Page Breaks - we do this for speed
                .DisplayPageBreaks = False
               
                Dim A As Range
               
                Do
                    Set A = Rows(1).Find(What:="To", LookIn:=xlValues, lookat:=xlPart)
                    If A Is Nothing Then Exit Do
                    A.EntireColumn.Delete
                Loop
               
            End With
           
            ActiveWindow.View = ViewMode
            With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
            ' -------------------------------------------------------
            ' Format date in column C
            Range("$C:$C").NumberFormat = "dd/mm/yyyy"
           
            ' Delete first three rows
            Rows("1:3").Delete
            ' -------------------------------------------------------
            ' Sort Warning Markers, firstly by values in array, then by date order
            Dim rData      As Range, rData1 As Range, rData2 As Range
            Dim r          As Long, i As Long, iLastSort As String
            Dim arySorts  As Variant
            Dim sLastSort  As String
           
            arySorts = Array("Domestic abuse/violence", "Violent", "Weapons", "Drugs", "Offends on bail") ' starts at 0
           
            Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
            Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
           
            Application.AddCustomList ListArray:=arySorts
           
            With ActiveSheet.Sort
                .SortFields.Clear
                .SortFields.Add Key:=rData1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=Application.CustomListCount
                .SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                .SetRange rData
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
                .SortFields.Clear
            End With
           
            Set rData2 = Nothing
            With rData
               
                'see which last sort is in data
                For i = UBound(arySorts) To LBound(arySorts) Step -1
                    iLastSort = -1
                    On Error Resume Next
                    iLastSort = Application.WorksheetFunction.Match(arySorts(i), Application.WorksheetFunction.Index(rData, 0, 2), 0)
                    On Error GoTo 0
                   
                    'found custom sort value
                    If iLastSort > -1 Then
                        sLastSort = LCase(arySorts(i))
                        Exit For
                    End If
                Next i
            End With
           
            'custom sort value found
            If Len(sLastSort) > 0 Then
               
                With rData
                    For r = .Rows.Count To 3 Step -1
                        If LCase(.Cells(r, 2).Value) = sLastSort Then
                            Set rData2 = .Cells(r + 1, 1)
                            Set rData2 = Range(rData2, rData2.End(xlDown).End(xlToRight))
                            Exit For
                        End If
                    Next
                End With
               
                'MsgBox rData2.Address
                With ActiveSheet.Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                    .SetRange rData2
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                    .SortFields.Clear
                End With
               
            End If
           
            Application.DeleteCustomList ListNum:=Application.CustomListCount
            ' -------------------------------------------------------
            ' Delete first column
            Columns(1).Delete
           
            ' Add row to top of worksheet
            Range("$A$1").EntireRow.Insert
           
            With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
           
            ' Add line of text to cell A1
            ActiveSheet.Range("A1").Value = "These are the warning markers shown :-" & vbCrLf
           
            ' Message box to show formatting complete
            Dim answer As Integer
           
            answer = MsgBox("Formatting of Warning Markers Complete", vbInformation + vbOKOnly, "Triage Hub")
            Application.ScreenUpdating = True
           
            Exit Sub
           
        End If
       
    Next
End Sub

---

Okay, I can check each ws checking for empty data using

Code:

---

Private Sub cmdWarning_Markers_Click()

    Dim CalcMode As Long, ViewMode As Long

    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        With ws
            If ws.name Like "Warning_Markers*" Then
                If WorksheetFunction.CountA(Cells) = 0 Then
                    MsgBox ws.name & " is empty"
                End If
         
            End If
           
        End With

    Next ws
    Exit Sub
   
End Sub

---

All I need now is for the sub 'Warning_Markers' to run if there is data in "Warning_Markers1" and / or "Warning_Markers2".

I'm thinking that a "Call Warning_Markers" will need to be used?

This suffices:

Code:

---

Sub M_snb()
  for each it in sheets
    if instr(it.name,"Warning") & it.usedrange="1$A$1" then msgbox it.name & " is empty"
  next
End Sub

---

Thanks, SNB.

Just need to get the sub 'Warning_Markers' to run if there is data in worksheets "Warning_Markers1" and / or "Warning_Markers2". Can / should this be incorporated in

Code:

---

Private Sub cmdWarning_Markers_Click()

---

or should it go at the start of the sub 'Warning_Markers'?

I've changed strategy and tried using an array.

If both "Warning_Markers1" and "Warning_Markers2" have no data in them, then the message box informs the user about each. Good stuff so far!

If "Warning_Markers1" contains data (nothing in "Warning_Markers2"), then running the same sub runs the "ElseIf" part of the code, but in theory looks to run the other sub twice over, thus producing the wrong result.

If there is no data in "Warning_Markers1", but there is in "Warning_Markers2", then there is no message box explaining there is no data for "Warning_Markers1" and ""Warning_Markers2" again seems to run the other sub twice over, again producing the wrong result. :banghead:

Code:

---

Private Sub cmdWarning_Markers_Click()

    Set wb = ActiveWorkbook
 
    For Each ws In Sheets(Array("Warning_Markers1", "Warning_Markers2"))
        If WorksheetFunction.CountA(Cells) = 0 Then
            MsgBox ws.name & " is empty"
           
        ElseIf WorksheetFunction.CountA(Cells) <> 0 Then
            Call Warning_Markers
        End If
         
    Next
    Exit Sub
   
End Sub






Private Sub Warning_Markers()

    Dim CalcMode As Long, ViewMode As Long
    ' -------------------------------------------------------
    ' Check for cells in row A that contain the word 'To'
    ' If any cells do then delete that column
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
   
    'If you are in Page Break Preview Or Page Layout view go
    'back to normal view, we do this for speed
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
   
    Dim A As Range
   
    Do
        Set A = Rows(1).Find(What:="To", LookIn:=xlValues, lookat:=xlPart)
        If A Is Nothing Then Exit Do
        A.EntireColumn.Delete
    Loop
   
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
    ' -------------------------------------------------------
    ' Format date in column C
    Range("$C:$C").NumberFormat = "dd/mm/yyyy"
   
    ' Delete first three rows
    Rows("1:3").Delete
    ' -------------------------------------------------------
    ' Sort Warning Markers, firstly by values in array, then by date order
    Dim rData      As Range, rData1 As Range, rData2 As Range
    Dim r          As Long, i As Long, iLastSort As String
    Dim arySorts  As Variant
    Dim sLastSort  As String
   
    arySorts = Array("Domestic abuse/violence", "Violent", "Weapons", "Drugs", "Offends on bail") ' starts at 0
   
    Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
    Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
   
    Application.AddCustomList ListArray:=arySorts
   
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rData1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=Application.CustomListCount
        .SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
        .SetRange rData
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        .SortFields.Clear
    End With
   
    Set rData2 = Nothing
    With rData
       
        'see which last sort is in data
        For i = UBound(arySorts) To LBound(arySorts) Step -1
            iLastSort = -1
            On Error Resume Next
            iLastSort = Application.WorksheetFunction.Match(arySorts(i), Application.WorksheetFunction.Index(rData, 0, 2), 0)
            On Error GoTo 0
           
            'found custom sort value
            If iLastSort > -1 Then
                sLastSort = LCase(arySorts(i))
                Exit For
            End If
        Next i
    End With
   
    'custom sort value found
    If Len(sLastSort) > 0 Then
       
        With rData
            For r = .Rows.Count To 3 Step -1
                If LCase(.Cells(r, 2).Value) = sLastSort Then
                    Set rData2 = .Cells(r + 1, 1)
                    Set rData2 = Range(rData2, rData2.End(xlDown).End(xlToRight))
                    Exit For
                End If
            Next
        End With
       
        'MsgBox rData2.Address
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
            .SetRange rData2
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            .SortFields.Clear
        End With
       
    End If
   
    Application.DeleteCustomList ListNum:=Application.CustomListCount
    ' -------------------------------------------------------
    ' Delete first column
    Columns(1).Delete
   
    ' Add row to top of worksheet
    Range("$A$1").EntireRow.Insert
   
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
   
    ' Add line of text to cell A1
    ActiveSheet.Range("A1").Value = "These are the warning markers shown :-" & vbCrLf
   
    ' Message box to show formatting complete
    Dim answer As Integer
   
    answer = MsgBox("Formatting of Warning Markers Complete", vbInformation + vbOKOnly, "Triage Hub")
    Application.ScreenUpdating = True
   
    Exit Sub
     
End Sub

---

Code:

---

Sub M_snb()
  for each it in sheets
    if instr(it.name,"Warning") & it.usedrange="1$A$1" then y=y+1
  next
  if y <2 then msgbox "it's only a matter of logic"
End Sub

---

Quote:

---

Originally Posted by snb

Code:

---

Sub M_snb()
  for each it in sheets
    if instr(it.name,"Warning") & it.usedrange="1$A$1" then y=y+1
  next
  if y <2 then msgbox "it's only a matter of logic"
End Sub

---

---

Thanks, snb.

I think I understand the logic, although I cannot fathom what "it" is to be able to make this work.

It even works without you understanding the code.

I'd really like to understand it as at the moment, I'm getting a "variable not defined" on 'it'.

I've tried substituting 'it' for the variable I had set for worksheet ('ws'), but this still doesn't work stating that "variable not defined" here

Code:

---

Then y = y + 1

---

Solved the problem!

Code:

---

Private Sub cmdWarning_Markers_Click()
   
    Application.ScreenUpdating = False
   
    Set ws = ThisWorkbook.Worksheets("Warning_Markers1")
    Sheets("Warning_Markers1").Activate
   
    With ws
        If WorksheetFunction.CountA(Cells) = 0 Then
            MsgBox ws.name & " is empty"
           
        ElseIf WorksheetFunction.CountA(Cells) <> 0 Then
            ' Perform a check to make sure that the macro hasn't already been run
            ' If it hasn't, then run it
           
            If Range("B1").Value = "Type" Then
               
                Warning_Markers
            ElseIf Range("B1").Value <> "Type" Then
                Exit Sub
            End If
        End If
    End With
   
    Set ws = ThisWorkbook.Worksheets("Warning_Markers2")
    Sheets("Warning_Markers2").Activate
   
    With ws
        If WorksheetFunction.CountA(Cells) = 0 Then
            MsgBox ws.name & " is empty"
           
        ElseIf WorksheetFunction.CountA(Cells) <> 0 Then
            ' Perform a check to make sure that the macro hasn't already been run
            ' If it hasn't, then run it
           
            If Range("B1").Value = "Type" Then
               
                Warning_Markers
            ElseIf Range("B1").Value <> "Type" Then
                Exit Sub
            End If
        End If
    End With
   
    Exit Sub
   
    Application.ScreenUpdating = True
   
End Sub

---