View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Casey[_114_] Casey[_114_] is offline
external usenet poster
 
Posts: 1
Default 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