+ Reply to Thread
Results 1 to 7 of 7

Help with do until loops.

Hybrid View

  1. #1
    Registered User
    Join Date
    12-08-2010
    Location
    Philippines
    MS-Off Ver
    Office 365
    Posts
    76

    Help with do until loops.

    Private Sub cmdCap_Click()
    On Error GoTo ErrHandler
    Dim ws As Worksheet
    Set ws = Worksheets("TDB")
    Dim b As Long
    Dim destRow As Long
    Dim d, d2 As Date
    Dim a As Integer
    
    
    ws.Activate
    
    Worksheets("TDB").Activate
    
    'Columns("I:I").Select
    'Selection.EntireColumn.Hidden = True
    
    Worksheets("TDB").Range("H3").Activate
    
    myRange = Worksheets("TDB").Range("H" & Rows.Count).End(xlUp).Row
    
    d = InputBox("Enter the" & " from " & "date (m/d/yyyy)", , Format(Now(), "m/d/yyyy")) - Start Date
    d2 = InputBox("Enter the" & " to " & "date (m/d/yyyy)", , Format(Now(), "m/d/yyyy")) - End date
    
    a = 4
    
    Do Until IsEmpty(Worksheets("TDB").Cells(a, 8))
    
    If Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "New Hire Training" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 5).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 5)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 6)
                
                Else
                
                Sheets("CAP").Cells(destRow, 5) = Sheets("CAP").Cells(destRow, 5).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 6) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 6).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                
                End If
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "Adhoc Training" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 7).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 7)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 8)
                
                Else
                
                Sheets("CAP").Cells(destRow, 7) = Sheets("CAP").Cells(destRow, 7).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 8) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 8).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "Module Design, Development & Maintenance" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 9).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 9)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 10)
                
                Else
                
                Sheets("CAP").Cells(destRow, 9) = Sheets("CAP").Cells(destRow, 9).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 10) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 10).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
                
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "Coaching" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 11).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 11)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 12)
                
                Else
                
                Sheets("CAP").Cells(destRow, 11) = Sheets("CAP").Cells(destRow, 11).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 12) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 12).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
                
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "Continuous Improvement Work" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 13).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 13)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 14)
                
                Else
                
                Sheets("CAP").Cells(destRow, 13) = Sheets("CAP").Cells(destRow, 13).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 14) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 14).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "CapDev Training" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 15).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 15)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 16)
                
                Else
                
                Sheets("CAP").Cells(destRow, 15) = Sheets("CAP").Cells(destRow, 15).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 16) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 16).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
    
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "Administrative Work" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 17).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 17)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 18)
                
                Else
                
                Sheets("CAP").Cells(destRow, 17) = Sheets("CAP").Cells(destRow, 17).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 18) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 18).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
    
    ElseIf Worksheets("TDB").Cells(a, 8).Value = d And Worksheets("TDB").Cells(a, 5).Value = "Meetings" Then
    
    Worksheets("CAP").Activate
    
    destRow = Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Row
            
            If Sheets("CAP").Cells(destRow, 19).Value = "" Then
    
                Sheets("TDB").Cells(a, 7).Copy Destination:=Sheets("CAP").Cells(destRow, 19)
                Sheets("TDB").Cells(a, 13).Copy Destination:=Sheets("CAP").Cells(destRow, 20)
                
                Else
                
                Sheets("CAP").Cells(destRow, 19) = Sheets("CAP").Cells(destRow, 19).Value & ", " & Sheets("TDB").Cells(a, 7).Value
                Sheets("CAP").Cells(destRow, 20) = "=" & "sum(" & Sheets("CAP").Cells(destRow, 20).Value & "," & Sheets("TDB").Cells(a, 13).Value & ")"
                End If
                
     End If
     Worksheets("TDB").Activate
     
    a = a + 1
    Loop
    
     
    Worksheets("TDB").Activate
    'Columns("I:I").Select
    'Selection.EntireColumn.Hidden = False
    
    ErrHandler:
      If Err.Number > 0 Then
      MsgBox "An error as occured. Error number: " & Err.Number & " Please try it again."
        
    Cancel = True
    Exit Sub
    
    End If
     
      End Sub
    d = InputBox("Enter the" & " from " & "date (m/d/yyyy)", , Format(Now(), "m/d/yyyy")) - Start Date
    d2 = InputBox("Enter the" & " to " & "date (m/d/yyyy)", , Format(Now(), "m/d/yyyy")) - End date

    What I want to happen is it will run the loop until the cell is empty and after checking all the rows, it will start the loop again with a different value of d.

    example, first run... it will check all the rows. the value of d = 3/1/2013 after that, it will check all the rows again and the value of d will be 3/2/2013 and so on...

  2. #2
    Registered User
    Join Date
    03-06-2013
    Location
    Malaysia
    MS-Off Ver
    Excel 2010
    Posts
    21

    Re: Help with do until loops.

    suggest using
    cel = 1
    while range("A" & cel).value <> " "
        braabrabrabra
        cel = cel +1
    wend

  3. #3
    Registered User
    Join Date
    03-06-2013
    Location
    Malaysia
    MS-Off Ver
    Excel 2010
    Posts
    21

    Re: Help with do until loops.

    suggest using
    cel = 1
    
    while range("A" & cel).value <> " "
        if d = #3/1/2013# then
            cel = 1
           d = DateAdd("d", 1, d)
        end if 
        cel = cel +1
    wend
    Last edited by zalora; 03-28-2013 at 06:35 AM. Reason: re code

  4. #4
    Registered User
    Join Date
    12-08-2010
    Location
    Philippines
    MS-Off Ver
    Office 365
    Posts
    76

    Re: Help with do until loops.

    is it really wend?

  5. #5
    Registered User
    Join Date
    03-06-2013
    Location
    Malaysia
    MS-Off Ver
    Excel 2010
    Posts
    21

    Re: Help with do until loops.

    of course in vb it is wend

  6. #6
    Registered User
    Join Date
    12-08-2010
    Location
    Philippines
    MS-Off Ver
    Office 365
    Posts
    76

    Re: Help with do until loops.

    I see. Thanks.

    =======================================
    d = 5
    d = 20

    a = 4
    Do Until IsEmpty(Worksheets("TDB").Cells(a, 8))

    Worksheets("TDB").Cells(a, 8).Value + d

    a = a+1
    loop
    =======================================
    let us say I have 100 rows. I need to check those 100 rows first before I change the value of d. How can I achieve this?

    so after 100 rows, d = 6
    after 100 rows, d = 7 and so on...

  7. #7
    Registered User
    Join Date
    03-06-2013
    Location
    Malaysia
    MS-Off Ver
    Excel 2010
    Posts
    21

    Re: Help with do until loops.

    while d <> 20
    For i =1 to 100
       brabrabrabrabra
    next i
    d = d +1
    wend

+ 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