ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Add a second condition to loop (https://www.excelbanter.com/excel-programming/365962-add-second-condition-loop.html)

Casey[_112_]

Add a second condition to loop
 

Hi,
I have a rountine that adds a sheet to a workbook. Part of the name of
the new sheet is based on finding the lowest missing integer in column
C which I've made a named range ("CWRCol"). Tom Ogilvy helped me with a
great bit of code to find this lowest missing integer and it works
perfect, but I need to add another condition to this routine.


Example

ColA..........ColC
blank............1
1..................2
1..................3
Void.............4
blank............5

In this senario the rountine returns 6 as the lowest missing integer,
but because the row with 4 in column C has "Void" in column A, I need
it to ignore 4 as if it weren't there and return 4 as the lowest
missing integer.

Here is my Code:

Sub Add_New_CWR()
Dim CopySht As Worksheet
Dim NewSht As Worksheet
Dim myVis As Long, m As Long, i As Long
Dim rDone As Boolean
Dim rng As Range
Dim Msg As Integer
Set CopySht = Worksheets("CWR 0")
'Find lowest missing CWR Number from column
'CWR# on CWR LOG from Tom Ogilvy
Set rng = Range("CWRCol")
If Application.Count(rng) = 0 Then
m = 1
rDone = True
Else
rDone = False
m = Application.Max(rng)
For i = 1 To m
If Application.CountIf(rng, i) = 0 Then 'And
m.address.Offset(0,-2) < "Void"

m = i
rDone = True
Exit For
End If
Next i
End If
If Not rDone Then
m = m + 1
End If
'.....check if sheet exists using Bob Phillips UDF SheetExists
If SheetExists("CWR " & m) = False Then
Application.ScreenUpdating = False
With CopySht
myVis = .Visible
..Visible = xlSheetVisible
..Copy After:=Sheets(ThisWorkbook.Sheets.Count)
..Visible = myVis
End With
Set NewSht = Sheets(ThisWorkbook.Sheets.Count)
With NewSht
..Name = "CWR " & m
End With
Application.ScreenUpdating = True
Else
Msg = MsgBox("The program has prevented the creation of a new CWR "
_
& (Chr(13)) & " because a previously created CWR has not been
logged" _
& (Chr(13)) & "and Saved to the file" _
& (Chr(13)) & (Chr(13)) & "Please use the Save to File and Export
to CWR Log " _
& (Chr(13)) & "button on any unsaved CWR." _
& (Chr(13)) & "Then you may return and create a new CWR.", _
vbOKCancel + vbCritical + vbDefaultButton1, "CWR Add Failed")
If Msg = vbOK Then 'Click OK
Exit Sub
End If
If Msg = vbCancel Then 'Click cancel
Exit Sub
End If
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=557355


JMB

Add a second condition to loop
 
Perhaps

If Application.CountIf(rng, i) = 0 Or _
rng.Offset(0, -2).Cells(Application.Match(i, rng, 0), 1) = "Void" Then


"Casey" wrote:


Hi,
I have a rountine that adds a sheet to a workbook. Part of the name of
the new sheet is based on finding the lowest missing integer in column
C which I've made a named range ("CWRCol"). Tom Ogilvy helped me with a
great bit of code to find this lowest missing integer and it works
perfect, but I need to add another condition to this routine.


Example

ColA..........ColC
blank............1
1..................2
1..................3
Void.............4
blank............5

In this senario the rountine returns 6 as the lowest missing integer,
but because the row with 4 in column C has "Void" in column A, I need
it to ignore 4 as if it weren't there and return 4 as the lowest
missing integer.

Here is my Code:

Sub Add_New_CWR()
Dim CopySht As Worksheet
Dim NewSht As Worksheet
Dim myVis As Long, m As Long, i As Long
Dim rDone As Boolean
Dim rng As Range
Dim Msg As Integer
Set CopySht = Worksheets("CWR 0")
'Find lowest missing CWR Number from column
'CWR# on CWR LOG from Tom Ogilvy
Set rng = Range("CWRCol")
If Application.Count(rng) = 0 Then
m = 1
rDone = True
Else
rDone = False
m = Application.Max(rng)
For i = 1 To m
If Application.CountIf(rng, i) = 0 Then 'And
m.address.Offset(0,-2) < "Void"

m = i
rDone = True
Exit For
End If
Next i
End If
If Not rDone Then
m = m + 1
End If
'.....check if sheet exists using Bob Phillips UDF SheetExists
If SheetExists("CWR " & m) = False Then
Application.ScreenUpdating = False
With CopySht
myVis = .Visible
.Visible = xlSheetVisible
.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
.Visible = myVis
End With
Set NewSht = Sheets(ThisWorkbook.Sheets.Count)
With NewSht
.Name = "CWR " & m
End With
Application.ScreenUpdating = True
Else
Msg = MsgBox("The program has prevented the creation of a new CWR "
_
& (Chr(13)) & " because a previously created CWR has not been
logged" _
& (Chr(13)) & "and Saved to the file" _
& (Chr(13)) & (Chr(13)) & "Please use the Save to File and Export
to CWR Log " _
& (Chr(13)) & "button on any unsaved CWR." _
& (Chr(13)) & "Then you may return and create a new CWR.", _
vbOKCancel + vbCritical + vbDefaultButton1, "CWR Add Failed")
If Msg = vbOK Then 'Click OK
Exit Sub
End If
If Msg = vbCancel Then 'Click cancel
Exit Sub
End If
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=557355



JMB

Add a second condition to loop
 
Please disregard. If there is no match you'll get an error.




"JMB" wrote:

Perhaps

If Application.CountIf(rng, i) = 0 Or _
rng.Offset(0, -2).Cells(Application.Match(i, rng, 0), 1) = "Void" Then


"Casey" wrote:


Hi,
I have a rountine that adds a sheet to a workbook. Part of the name of
the new sheet is based on finding the lowest missing integer in column
C which I've made a named range ("CWRCol"). Tom Ogilvy helped me with a
great bit of code to find this lowest missing integer and it works
perfect, but I need to add another condition to this routine.


Example

ColA..........ColC
blank............1
1..................2
1..................3
Void.............4
blank............5

In this senario the rountine returns 6 as the lowest missing integer,
but because the row with 4 in column C has "Void" in column A, I need
it to ignore 4 as if it weren't there and return 4 as the lowest
missing integer.

Here is my Code:

Sub Add_New_CWR()
Dim CopySht As Worksheet
Dim NewSht As Worksheet
Dim myVis As Long, m As Long, i As Long
Dim rDone As Boolean
Dim rng As Range
Dim Msg As Integer
Set CopySht = Worksheets("CWR 0")
'Find lowest missing CWR Number from column
'CWR# on CWR LOG from Tom Ogilvy
Set rng = Range("CWRCol")
If Application.Count(rng) = 0 Then
m = 1
rDone = True
Else
rDone = False
m = Application.Max(rng)
For i = 1 To m
If Application.CountIf(rng, i) = 0 Then 'And
m.address.Offset(0,-2) < "Void"

m = i
rDone = True
Exit For
End If
Next i
End If
If Not rDone Then
m = m + 1
End If
'.....check if sheet exists using Bob Phillips UDF SheetExists
If SheetExists("CWR " & m) = False Then
Application.ScreenUpdating = False
With CopySht
myVis = .Visible
.Visible = xlSheetVisible
.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
.Visible = myVis
End With
Set NewSht = Sheets(ThisWorkbook.Sheets.Count)
With NewSht
.Name = "CWR " & m
End With
Application.ScreenUpdating = True
Else
Msg = MsgBox("The program has prevented the creation of a new CWR "
_
& (Chr(13)) & " because a previously created CWR has not been
logged" _
& (Chr(13)) & "and Saved to the file" _
& (Chr(13)) & (Chr(13)) & "Please use the Save to File and Export
to CWR Log " _
& (Chr(13)) & "button on any unsaved CWR." _
& (Chr(13)) & "Then you may return and create a new CWR.", _
vbOKCancel + vbCritical + vbDefaultButton1, "CWR Add Failed")
If Msg = vbOK Then 'Click OK
Exit Sub
End If
If Msg = vbCancel Then 'Click cancel
Exit Sub
End If
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=557355



JMB

Add a second condition to loop
 

For i = 1 To m
If Application.CountIf(rng, i) = 0 Then
m = i
rDone = True
Exit For
ElseIf rng.Offset(0, -2).Cells(Application.Match(i, rng, 0), 1) = "Void" Then
m = i
rDone = True
Exit For
End If
Next i


"JMB" wrote:

Perhaps

If Application.CountIf(rng, i) = 0 Or _
rng.Offset(0, -2).Cells(Application.Match(i, rng, 0), 1) = "Void" Then


"Casey" wrote:


Hi,
I have a rountine that adds a sheet to a workbook. Part of the name of
the new sheet is based on finding the lowest missing integer in column
C which I've made a named range ("CWRCol"). Tom Ogilvy helped me with a
great bit of code to find this lowest missing integer and it works
perfect, but I need to add another condition to this routine.


Example

ColA..........ColC
blank............1
1..................2
1..................3
Void.............4
blank............5

In this senario the rountine returns 6 as the lowest missing integer,
but because the row with 4 in column C has "Void" in column A, I need
it to ignore 4 as if it weren't there and return 4 as the lowest
missing integer.

Here is my Code:

Sub Add_New_CWR()
Dim CopySht As Worksheet
Dim NewSht As Worksheet
Dim myVis As Long, m As Long, i As Long
Dim rDone As Boolean
Dim rng As Range
Dim Msg As Integer
Set CopySht = Worksheets("CWR 0")
'Find lowest missing CWR Number from column
'CWR# on CWR LOG from Tom Ogilvy
Set rng = Range("CWRCol")
If Application.Count(rng) = 0 Then
m = 1
rDone = True
Else
rDone = False
m = Application.Max(rng)
For i = 1 To m
If Application.CountIf(rng, i) = 0 Then 'And
m.address.Offset(0,-2) < "Void"

m = i
rDone = True
Exit For
End If
Next i
End If
If Not rDone Then
m = m + 1
End If
'.....check if sheet exists using Bob Phillips UDF SheetExists
If SheetExists("CWR " & m) = False Then
Application.ScreenUpdating = False
With CopySht
myVis = .Visible
.Visible = xlSheetVisible
.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
.Visible = myVis
End With
Set NewSht = Sheets(ThisWorkbook.Sheets.Count)
With NewSht
.Name = "CWR " & m
End With
Application.ScreenUpdating = True
Else
Msg = MsgBox("The program has prevented the creation of a new CWR "
_
& (Chr(13)) & " because a previously created CWR has not been
logged" _
& (Chr(13)) & "and Saved to the file" _
& (Chr(13)) & (Chr(13)) & "Please use the Save to File and Export
to CWR Log " _
& (Chr(13)) & "button on any unsaved CWR." _
& (Chr(13)) & "Then you may return and create a new CWR.", _
vbOKCancel + vbCritical + vbDefaultButton1, "CWR Add Failed")
If Msg = vbOK Then 'Click OK
Exit Sub
End If
If Msg = vbCancel Then 'Click cancel
Exit Sub
End If
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=557355



Casey[_114_]

Add a second condition to loop
 

JMB,
Thank you very much for the reply. I apologize for taking so long to
reply. Our e-mail went down last week and on top of that I've been out
with an impacted wisdom tooth. Your post gave me just the right
direction I needed to be able to construct a working solution. Again
thanks for the help.

Here is my finished code using your idea.

Sub Add_New_CWR()
Dim CopySht As Worksheet
Dim NewSht As Worksheet
Dim myVis As Long, m As Long, i As Long
Dim rDone As Boolean
Dim rng As Range, v As Range
Dim Msg As Integer
Set CopySht = Worksheets("CWR 0")
'Find lowest missing CWR Number from column
'CWR# on CWR LOG from Tom Ogilvy and JMB

Set rng = Range("CWRCol")

If Application.Count(rng) = 0 Then
m = 1
rDone = True
Else
rDone = False
m = Application.Max(rng)
For i = 1 To m
If Application.CountIf(rng, i) 0 And rng.Offset(0, -2) _
..Cells(Application.Match(i, rng, 0), 1).Value = "VOID" Then
m = i
rDone = True
Exit For
ElseIf Application.CountIf(rng, i) = 0 Then
m = i
rDone = True
Exit For
End If
Next i
End If
If Not rDone Then
m = m + 1
End If
'.....check if sheet exists using Bob Phillips UDF SheetExists
If SheetExists("CWR " & m) = False Then
Application.ScreenUpdating = False
With CopySht
myVis = .Visible
..Visible = xlSheetVisible
..Copy After:=Sheets(ThisWorkbook.Sheets.Count)
..Visible = myVis
End With
Set NewSht = Sheets(ThisWorkbook.Sheets.Count)
With NewSht
..Name = "CWR " & m
End With
Application.ScreenUpdating = True
Else
Msg = MsgBox("The program has prevented the creation of a new CWR "
_
& (Chr(13)) & " because a previously created CWR has not been
logged" _
& (Chr(13)) & "and Saved to the file" _
& (Chr(13)) & (Chr(13)) & "Please use the Save to File and Export
to CWR Log " _
& (Chr(13)) & "button on any unsaved CWR." _
& (Chr(13)) & "Then you may return and create a new CWR.", _
vbOKCancel + vbCritical + vbDefaultButton1, "CWR Add Failed")
If Msg = vbOK Then 'Click OK
Exit Sub
End If
If Msg = vbCancel Then 'Click cancel
Exit Sub
End If
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=557355


JMB

Add a second condition to loop
 
Glad to help.

"Casey" wrote:


JMB,
Thank you very much for the reply. I apologize for taking so long to
reply. Our e-mail went down last week and on top of that I've been out
with an impacted wisdom tooth. Your post gave me just the right
direction I needed to be able to construct a working solution. Again
thanks for the help.

Here is my finished code using your idea.

Sub Add_New_CWR()
Dim CopySht As Worksheet
Dim NewSht As Worksheet
Dim myVis As Long, m As Long, i As Long
Dim rDone As Boolean
Dim rng As Range, v As Range
Dim Msg As Integer
Set CopySht = Worksheets("CWR 0")
'Find lowest missing CWR Number from column
'CWR# on CWR LOG from Tom Ogilvy and JMB

Set rng = Range("CWRCol")

If Application.Count(rng) = 0 Then
m = 1
rDone = True
Else
rDone = False
m = Application.Max(rng)
For i = 1 To m
If Application.CountIf(rng, i) 0 And rng.Offset(0, -2) _
.Cells(Application.Match(i, rng, 0), 1).Value = "VOID" Then
m = i
rDone = True
Exit For
ElseIf Application.CountIf(rng, i) = 0 Then
m = i
rDone = True
Exit For
End If
Next i
End If
If Not rDone Then
m = m + 1
End If
'.....check if sheet exists using Bob Phillips UDF SheetExists
If SheetExists("CWR " & m) = False Then
Application.ScreenUpdating = False
With CopySht
myVis = .Visible
.Visible = xlSheetVisible
.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
.Visible = myVis
End With
Set NewSht = Sheets(ThisWorkbook.Sheets.Count)
With NewSht
.Name = "CWR " & m
End With
Application.ScreenUpdating = True
Else
Msg = MsgBox("The program has prevented the creation of a new CWR "
_
& (Chr(13)) & " because a previously created CWR has not been
logged" _
& (Chr(13)) & "and Saved to the file" _
& (Chr(13)) & (Chr(13)) & "Please use the Save to File and Export
to CWR Log " _
& (Chr(13)) & "button on any unsaved CWR." _
& (Chr(13)) & "Then you may return and create a new CWR.", _
vbOKCancel + vbCritical + vbDefaultButton1, "CWR Add Failed")
If Msg = vbOK Then 'Click OK
Exit Sub
End If
If Msg = vbCancel Then 'Click cancel
Exit Sub
End If
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=557355




All times are GMT +1. The time now is 10:24 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com