Do Until Loop Problem

Hashiru

Active Member
Joined
May 29, 2011
Messages
286
Hi everyone,

See a snippet of my spreadsheet, showing rows and columns that contain data. Note that Data in the ranges B4:B7, E4:E7, B11:B14 and E11:E14 are merged.
The Direct Labor for the first person should be 51+4+1 = 56 hr and 3197.18+250.76+62.69 = 3510.63

The Direct Labor for the first person should be 11+3 = 14 hr and 705.13+192.31=897.44

Code:
Public OldSht As Worksheet, NewSht As Worksheet
Public n As Long, o As Long
Public NextRow As Long, RowCount As Long, RowN As Long, Rowx As Long, Row1 As Long
Public DL As Long, GA As Long, HO As Long, PT As Long, CO As Long, HL As Long, LP As Long, SA As Long, OH As Long, SO As Long, SAJ As Long, SH As Long, MI As Long
Public onea As Long, oneb As Long, onec As Long, dd As Long, ee As Long, ff As Long
Public rng1 As Range, rng2 As Range, rng3 As Range


Sub PayStub()


Set OldSht = Worksheets("Table 1"): Set NewSht = Worksheets("Data")
     TotalRow = OldSht.Cells(Rows.Count, 1).End(xlUp).Row


OldSht.Activate
OldSht.Cells(1, 1).Select


For i = 2 To TotalRow
    If Left(OldSht.Cells(i, 1), 5) = "Name:" Then
    Counter = Counter + 1
    End If
Next i


OldSht.Cells(1, 1).Select
For j = 1 To Counter
OldSht.Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate
m = ActiveCell.Row


NextEE = OldSht.Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
       
n = OldSht.Range(Cells(m, 1), Cells(NextEE, 16)).Find(What:="Earnings", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
o = n


Ra = InStr(0 + 1, OldSht.Cells(m, 1), ":")
Rb = InStrRev(OldSht.Cells(m, 1), ":", -1) - 8


NextRow = NewSht.Cells(Rows.Count, 1).End(xlUp).Row + 1


NewSht.Cells(NextRow, 1) = Trim(Mid(OldSht.Cells(m, 1), Ra + 1, Rb - Ra))
OldSht.Cells(n, 1).Select
Rowx = 1
If InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10)) = 0 Then
RowCount = Range(Selection, Selection.End(xlDown)).Count
    'Check this line
    Do Until OldSht.Cells(o + 1, 1) = "" Or InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10)) > 0
        
        Earning = OldSht.Cells(o + 1, 1)
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = OldSht.Cells(n + 1, 2)
                NewSht.Cells(NextRow, 4) = OldSht.Cells(n + 1, 5)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + OldSht.Cells(n + 1, 2)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + OldSht.Cells(n + 1, 5)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + OldSht.Cells(n + 1, 2)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + OldSht.Cells(n + 1, 5)
            End If
        End If
        o = o + 1: n = n + 1: Rowx = Rowx + 1
    Loop


ElseIf InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10)) > 0 Then
   MergedCellsWork
End If


        If Rowx = RowCount Then
        ElseIf Rowx < RowCount Then
          NotCompletelyMerged
        ElseIf Rowx < RowCount Then
        
        End If
        
         RowCount = 0: DL = 0: GA = 0: HO = 0: PT = 0: CO = 0: HL = 0: LP = 0: SA = 0: HO = 0: SO = 0: SAJ = 0: SH = 0: MI = 0 ': RowN = 0
Next j


End Sub




Sub MergedCellsWork()
    a = InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10))
    b = InStr(a + 1, OldSht.Cells(n + 1, 2), Chr(10))
    c = InStr(b + 1, OldSht.Cells(n + 1, 2), Chr(10))
    
    d = InStr(0 + 1, OldSht.Cells(n + 1, 5), Chr(10))
    e = InStr(d + 1, OldSht.Cells(n + 1, 5), Chr(10))
    f = InStr(e + 1, OldSht.Cells(n + 1, 5), Chr(10))


Rowx = 1
RowCount = Range(Selection, Selection.End(xlDown)).Count


Do Until OldSht.Cells(o + 1, 1) = ""
    
    Earning = OldSht.Cells(o + 1, 1)
    
    If Rowx = 1 Then
    
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Left(OldSht.Cells(n + 1, 2), a - 1)
                NewSht.Cells(NextRow, 4) = Left(OldSht.Cells(n + 1, 5), d - 1)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Left(OldSht.Cells(n + 1, 2), a - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Left(OldSht.Cells(n + 1, 5), d - 1)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Left(OldSht.Cells(n + 1, 2), a - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Left(OldSht.Cells(n + 1, 5), d - 1)
            End If
        End If
    ElseIf Rowx = 2 Then
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Mid(OldSht.Cells(n + 1, 2), a + 1, b - a - 1)
                NewSht.Cells(NextRow, 4) = Mid(OldSht.Cells(n + 1, 5), d + 1, e - d - 1)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), a + 1, b - a - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), d + 1, e - d - 1)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), a + 1, b - a - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), d + 1, e - d - 1)
            End If
        End If
    ElseIf Rowx = 3 Then
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Mid(OldSht.Cells(n + 1, 2), b + 1, Len(OldSht.Cells(n + 1, 2)) - b)
                NewSht.Cells(NextRow, 4) = Mid(OldSht.Cells(n + 1, 5), e + 1, Len(OldSht.Cells(n + 1, 5)) - e)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), b + 1, Len(OldSht.Cells(n + 1, 2)) - b)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 5), e + 1, Len(OldSht.Cells(n + 1, 5)) - e)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), b + 1, Len(OldSht.Cells(n + 1, 2)) - b)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 5), e + 1, Len(OldSht.Cells(n + 1, 5)) - e)
            End If
        End If
    End If
    o = o + 1: Rowx = Rowx + 1
Loop
End Sub
Sub NotCompletelyMerged()
        
        Row1 = o
        xCheck = Row1
        onea = InStr(0 + 1, OldSht.Cells(Row1 + 1, 2), Chr(10))
        oneb = InStr(onea + 1, OldSht.Cells(Row1 + 1, 2), Chr(10))
        onec = InStr(oneb + 1, OldSht.Cells(Row1 + 1, 2), Chr(10))
            
        dd = InStr(0 + 1, OldSht.Cells(Row1 + 1, 5), Chr(10))
        ee = InStr(dd + 1, OldSht.Cells(Row1 + 1, 5), Chr(10))
        ff = InStr(ee + 1, OldSht.Cells(Row1 + 1, 5), Chr(10))
         
         'Level one control number of merge items
        If onea > 0 And oneb > 0 And onec > 0 Then
            'Do
            Do Until OldSht.Cells(Row1 + 1, 1) = "" Or InStr(0 + 1, OldSht.Cells(Row1 + 1, 2), Chr(10)) = 0
                   Earnings = OldSht.Cells(Row1 + 1, 1)
                   LoopNumb = LoopNumb + 1
                   If onec = 0 Then
                       If LoopNumb = 1 Then
                           RunLoopRun1
                       ElseIf LoopNumb = 2 Then
                           RunLoopRun2
                       ElseIf LoopNumb = 3 Then
                           RunLoopRun3
                       ElseIf LoopNumb = 4 Then
                           RunLoopRun4
                       End If
                   ElseIf onec > 0 Then
                       If LoopNumb = 1 Then
                           RunLoopRun1
                       ElseIf LoopNumb = 2 Then
                           RunLoopRun2
                       ElseIf LoopNumb = 3 Then
                           RunLoopRun3A
                       ElseIf LoopNumb = 4 Then
                           RunLoopRun4
                       End If
                   End If
                   xCheck = xCheck + 1
            Loop
            'Loop While InStr(0 + 1, OldSht.Cells(xCheck + 1, 2), Chr(10)) > 0


         ElseIf onea > 0 And oneb > 0 And onec = 0 Then
                     Do Until OldSht.Cells(Row1 + 1, 1) = "" Or InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10)) = 0
                            Earnings = OldSht.Cells(Row1 + 1, 1)
                            LoopNumb = LoopNumb + 1
                                If LoopNumb = 1 Then
                                    RunLoopRun1
                                ElseIf LoopNumb = 2 Then
                                    RunLoopRun2
                                ElseIf LoopNumb = 3 Then
                                    RunLoopRun3
                                End If
                     Loop
         ElseIf onea > 0 And oneb = 0 And onec = 0 Then
                     Do Until OldSht.Cells(Row1 + 1, 1) = "" Or InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10)) = 0
                            LoopNumb = LoopNumb + 1
                                If LoopNumb = 1 Then
                                    RunLoopRun1
                                ElseIf LoopNumb = 2 Then
                                    RunLoopRun2
                                End If
                     Loop
         ElseIf onea > 0 And oneb = 0 And onec >= 0 Then
                     Do Until OldSht.Cells(Row1 + 1, 1) = "" Or InStr(0 + 1, OldSht.Cells(n + 1, 2), Chr(10)) = 0
                            LoopNumb = LoopNumb + 1
                                If LoopNumb = 1 Then
                                    RunLoopRun1
                                End If
                     Loop
         End If
End Sub
Sub RunLoopRun1()
        Earning = OldSht.Cells(Row1 + 1, 1)
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Left(OldSht.Cells(n + 1, 2), onea - 1)
                NewSht.Cells(NextRow, 4) = Left(OldSht.Cells(n + 1, 5), dd - 1)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Left(OldSht.Cells(n + 1, 2), onea - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Left(OldSht.Cells(n + 1, 5), dd - 1)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Left(OldSht.Cells(n + 1, 2), onea - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Left(OldSht.Cells(n + 1, 5), dd - 1)
            End If
        End If
         Row1 = Row1 + 1: Rowx = Rowx + 1
                   
End Sub
Sub RunLoopRun2()
        Earning = OldSht.Cells(Row1 + 1, 1)
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Mid(OldSht.Cells(n + 1, 2), onea + 1, oneb - onea)
                NewSht.Cells(NextRow, 4) = Mid(OldSht.Cells(n + 1, 5), dd + 1, ee - dd)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), onea + 1, oneb - onea - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), dd + 1, ee - dd - 1)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), onea + 1, oneb - onea - 1)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), dd + 1, ee - dd - 1)
            End If
        End If
           Row1 = Row1 + 1: Rowx = Rowx + 1
                   
End Sub
Sub RunLoopRun3()
        Earning = OldSht.Cells(Row1 + 1, 1)
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Mid(OldSht.Cells(n + 1, 2), oneb + 1, Len(OldSht.Cells(n + 1, 2)) - oneb)
                NewSht.Cells(NextRow, 4) = Mid(OldSht.Cells(n + 1, 5), ee + 1, Len(OldSht.Cells(n + 1, 5)) - ee)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), oneb + 1, Len(OldSht.Cells(n + 1, 2)) - oneb)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), ee + 1, Len(OldSht.Cells(n + 1, 5)) - ee)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), oneb + 1, Len(OldSht.Cells(n + 1, 2)) - oneb)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), ee + 1, Len(OldSht.Cells(n + 1, 5)) - ee)
            End If
        End If
          Row1 = Row1 + 1: Rowx = Rowx + 1
                   
End Sub
Sub RunLoopRun3A()
        Earning = OldSht.Cells(Row1 + 1, 1)
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Mid(OldSht.Cells(n + 1, 2), oneb + 1, onec - oneb)
                NewSht.Cells(NextRow, 4) = Mid(OldSht.Cells(n + 1, 5), ee + 1, ff - ee)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), oneb + 1, onec - oneb)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), ee + 1, ff - ee)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), oneb + 1, onec - oneb)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), ee + 1, ff - ee)
            End If
        End If
              Row1 = Row1 + 1: Rowx = Rowx + 1
                   
End Sub
Sub RunLoopRun4()
        Earning = OldSht.Cells(Row1 + 1, 1)
        If Earning = "DIRECT LABOR" Then
            DL = DL + 1
            If DL = 1 Then
                NewSht.Cells(NextRow, 3) = Mid(OldSht.Cells(n + 1, 2), onec + 1, Len(OldSht.Cells(n + 1, 2)) - onec)
                NewSht.Cells(NextRow, 4) = Mid(OldSht.Cells(n + 1, 5), ff + 1, Len(OldSht.Cells(n + 1, 5)) - ff)
            ElseIf DL = 2 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), onec + 1, Len(OldSht.Cells(n + 1, 2)) - onec)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), ff + 1, Len(OldSht.Cells(n + 1, 5)) - ff)
            ElseIf DL = 3 Then
                NewSht.Cells(NextRow, 3) = NewSht.Cells(NextRow, 3) + Mid(OldSht.Cells(n + 1, 2), onec + 1, Len(OldSht.Cells(n + 1, 2)) - onec)
                NewSht.Cells(NextRow, 4) = NewSht.Cells(NextRow, 4) + Mid(OldSht.Cells(n + 1, 5), ff + 1, Len(OldSht.Cells(n + 1, 5)) - ff)
            End If
        End If
           Row1 = Row1 + 1: Rowx = Rowx + 1
                   
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Hello All,

Here is the spreadsheet for the questions above. Sorry, I was learning how to use this add-in. Apparently, it was not working on my previous machine.

Thanks for you help in advance.



ABCDEFGHIJKLMNOP
Name: FirstName1, JR, LastName1 R. Address: Address1
City1, VA 00000
Hire Date 2/02/2002
Direct Deposit 1045
Pay Period Begin: 12/16/2016 Pay Period End: 12/31/2016 Pay Date: 1/6/2017
EarningsHoursCurrent
51.003,197.18
24.00
8.00
4.00
1.00
62.69
62.69
62.69
62.69
1,504.55
501.52
250.76
62.69
2450
6520
5767
5296
Name: FirstName2, JR, LastName2 R. Address: Address2
City2, MD 00000
Hire Date 2/02/2002
Direct Deposit 1045
Pay Period Begin: 12/20/2002 Pay Period End: 12/31/2002Pay Date: 1/6/2002
EarningsHoursCurrent
65.004,166.67
40.00
11.00
8.00
4.00
67.31
64.10
64.10
64.10
2450
0916
6520
2450
3.0064.10192.316536

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]Rate[/TD]

[TD="align: center"]Acct #[/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFF7F"]DIRECT LABOR[/TD]

[TD="align: center"]62.69[/TD]

[TD="align: center"]5296[/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFF7F"]PTO[/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: #FFFF7F"]HOLIDAY[/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: #FFFF7F"]DIRECT LABOR[/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: #FFFF7F"]DIRECT LABOR[/TD]

[TD="align: center"]8[/TD]

[TD="align: center"]9[/TD]

[TD="align: center"]Rate[/TD]

[TD="align: center"]Acct #[/TD]

[TD="align: center"]10[/TD]
[TD="bgcolor: #FFFF7F"]OVERHEAD[/TD]

[TD="align: center"]64.10[/TD]

[TD="align: center"]7001[/TD]

[TD="align: center"]11[/TD]
[TD="bgcolor: #FFFF7F"]LEAVE PAYOUT[/TD]

[TD="align: center"]2,692.31
705.13
512.82
256.41[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]12[/TD]
[TD="bgcolor: #FFFF7F"]DIRECT LABOR[/TD]

[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]13[/TD]
[TD="bgcolor: #FFFF7F"]HOLIDAY[/TD]

[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]14[/TD]
[TD="bgcolor: #FFFF7F"]PTO[/TD]

[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]15[/TD]
[TD="bgcolor: #FFFF7F"]DIRECT LABOR[/TD]

[TD="align: center"]16[/TD]
[TD="bgcolor: #FFFF7F"][/TD]

</tbody>
Sheet1
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,259
Members
452,626
Latest member
huntinghunter

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top