+ Reply to Thread
Results 1 to 6 of 6

Add a second condition to loop

  1. #1
    Forum Contributor
    Join Date
    01-06-2004
    Location
    Carbondale CO
    Posts
    245

    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

  2. #2
    JMB
    Guest

    RE: 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
    >
    >


  3. #3
    JMB
    Guest

    RE: 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
    > >
    > >


  4. #4
    JMB
    Guest

    RE: 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
    > >
    > >


  5. #5
    Forum Contributor
    Join Date
    01-06-2004
    Location
    Carbondale CO
    Posts
    245
    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

  6. #6
    JMB
    Guest

    Re: 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
    >
    >


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1