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