modifying code(add condition)

Hasson

Active Member
Joined
Apr 8, 2021
Messages
401
Office Version
  1. 2016
Platform
  1. Windows
Hi
first thanks for @Alex Blakenburg's code
I want prventing add new sheet based on columns D,E,G contains zero or empty together.
if they contain zero values or empty cells together in columns D:E,G , then should show message"please fill numbers for columns D:E,G before adding new sheet" if they contain numeric values except zero , then should add new sheet as the orginal code does it (should be one of the columns contain numeric not should all of the columns contain numeric together as in first case when they contain zero values or empty cells together)
the original code will create new sheet with the same borders and formatting based on previous sheet and increment number for new sheet name .
just I need to add condition based on column D:E,G to prevent add new sheet if column D:E,G equal zero or empty cells .
VBA Code:
Sub new_report_MthName()
    Dim a
    Dim sht As Worksheet
    Dim shtName As String
    Dim NameSuffix As String, NameMain As String
    Dim currMth As Date

    Set sht = Worksheets(Sheets.Count)
    shtName = sht.Name
    
    NameMain = Left(shtName, InStrRev(shtName, " "))
    NameSuffix = Right(shtName, Len(shtName) - InStrRev(shtName, " "))
    
    If UCase(NameSuffix) = "DECEMBER" Then
        MsgBox "you should create new file"
        Exit Sub
    End If
    
    On Error Resume Next
    currMth = DateValue("1-" & NameSuffix)
    If Err = 0 Then
        NameSuffix = UCase(MonthName(Month(currMth) + 1))
        Else
        NameMain = shtName
        NameSuffix = " JANUARY"
    End If
    On Error GoTo 0

    sht.Copy After:=Sheets(Sheets.Count)
    With ActiveSheet.Cells(1).CurrentRegion.Offset(1)
        ActiveSheet.Name = NameMain & NameSuffix
        a = .Value
        .ClearContents
        Cells(2, 1).Resize(UBound(a), 3) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), Array(1, 2, 6))
    End With
 
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
See if this works for you:
The Set sht line is only to show you where to put the additional code.
I am only checking by using Sum so if you think you will have positive and negative numbers that will total to zero, this won't work.

Rich (BB code):
    Set sht = Worksheets(Sheets.Count)
    
    ' ---- Additional request for Criteria ---
    ' Assumes the check range does not have positive and negative values totalling 0
    Dim lastRow As Long
    Dim rng As Range
    Dim SumRng As Double
    With sht
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = Union(.Range("D1:E" & lastRow), .Range("G1:G" & lastRow))
        SumRng = Application.Sum(rng)
        SumRng = Application.Round(SumRng, 5)
        If SumRng = 0 Then
            MsgBox "please fill numbers for columns D:E,G before adding new sheet"
        End If
    End With
    ' ---- End of additional request ----
 
Upvote 0
Solution
Hi Alex ,
if you think you will have positive and negative numbers
then should add new sheet as the orginal code does it .
it should start from row 2 because the header in row 1 I change to
VBA Code:
Set rng = Union(.Range("D2:E" & lastRow), .Range("G2:G" & lastRow))
it doesn't seem to work, just show the message after press ok the message will add new sheet when column D,E,G are zero from row2
last thing , not only zero also if they are empty cells together .
thanks
 
Upvote 0
Oops. Directly after the msgbox line add this line:
VBA Code:
Exit Sub

Sum will treat blank cells as zero so total of zeroes and blanks should Sum to 0
 
Last edited:
Upvote 0
it works , but should not convert enering values except zero to zero when I add 100, 2, 80 I need saving what I enter the numbers , then will add new sheet as the code does it .
 
Upvote 0
I'm afraid I don't understand what you are saying.
The only thing I added was Sum Columns D, E & G down to the last row per column A in the last sheet in the workbook.
And if that Sum totals zero (which happens if all cells are blank or zero), then give you the message you asked for and exit the code.
just I need to add condition based on column D:E,G to prevent add new sheet if column D:E,G equal zero or empty cells .


What is it not doing that you need it to do ?
 
Upvote 0
sorry Alex !:eek:
I thought your modifying doesn't allow me entering the numbers by convert to zero .
every thing is perfect (y)
again many thanks for your help .
 
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,316
Members
452,634
Latest member
cpostell

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