Do Until Loop Problem

H

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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
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
1Name: 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
2EarningsHoursRateCurrentAcct #
3DIRECT LABOR51.0062.693,197.185296
4PTO24.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
5HOLIDAY
6DIRECT LABOR
7DIRECT LABOR
8Name: 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
9EarningsHoursRateCurrentAcct #
10OVERHEAD65.0064.104,166.677001
11LEAVE PAYOUT40.00
11.00
8.00
4.00		67.31
64.10
64.10
64.10		2,692.31
705.13
512.82
256.41		2450
0916
6520
2450
12DIRECT LABOR
13HOLIDAY
14PTO
15DIRECT LABOR3.0064.10192.316536
16

<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>
</tbody>
Sheet1​
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Retrieving file attributes
Replies
1
Views
201
jkpieterse
jkpieterse
B
  • Solved
runtime error 91: object variable or with block variable not set
Replies
2
Views
155
benefuexx
B
zookeepertx
  • Question
Having trouble "deciphering" some code so I can see how it works
Replies
1
Views
30
Jeffrey Mahoney
Jeffrey Mahoney
S
  • Question
Change date format inside textbox userform
Replies
1
Views
82
Akuini
Akuini
rjplante
  • Solved
sort numbers with letters
2 3
Replies
24
Views
311
Akuini
Akuini

Forum statistics

Threads
1,214,920
Messages
6,122,262
Members
449,075
Latest member
staticfluids

Share this page

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