Add a second condition to loop

[Casey]

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

 

[Guest]

Perhaps

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

 

[Guest]

Please disregard. If there is no match you'll get an error.

Perhaps

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

 

[Guest]

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

Perhaps

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

 

[Casey]

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

 

[Guest]

Glad to help.