Using range.find with an offset

F

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name (Column AD)[/TD]
[TD]Category (AE)[/TD]
[TD]Total Hrs (AF)[/TD]
[TD]Pay Rate (AG)[/TD]
[TD]Wage (AH)[/TD]
[/TR]
[TR]
[TD]John Doe 1[/TD]
[TD]TT Field[/TD]
[TD]12.5[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD]$104.55/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="align: right"]$1,306.88[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 2[/TD]
[TD]TT Field[/TD]
[TD]4[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD]$104.55/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="align: right"]$418.20[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 3[/TD]
[TD]Field[/TD]
[TD]15[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$522.75[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 4[/TD]
[TD]Field[/TD]
[TD]37[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$1,289.45[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 5[/TD]
[TD]Field[/TD]
[TD]8[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$30.70/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$245.60[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 6[/TD]
[TD]Field[/TD]
[TD]15[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$27.95/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$419.25[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 7[/TD]
[TD]Field[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$1,289.45[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


Bit stumped here. I'm not sure what I've been having issues with, but after this morning, I just deleted all my vba and started from scratch. I'm not sure if it's because the data I'm searching has a"/hr" and it's causing issues with finding it, but either way, I'm lost here.


I'm looking for a way to program a command button that can do the following.

* Search Column AG (pay rate) in range AG5:AG148 for all similar entries, and then add the number of hours in AF (Total Hrs Column) for all similar pay rates. There can be up to 168 different pay rates that could be in this column, so we would need to come up with a way that can search for identicals.
- For example, there might be 20 people with the same pay rate, so I'm looking to easily add the total hours for each unique pay rate.


[TABLE="width: 500"]
<tbody>[TR]
[TD]Name (Column AD)[/TD]
[TD]Category (AE)[/TD]
[TD]Total Hrs (AF)[/TD]
[TD]Pay Rate (AG)[/TD]
[TD]Wage (AH)[/TD]
[/TR]
[TR]
[TD]John Doe 1[/TD]
[TD]TT Field[/TD]
[TD]12.5[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD]$104.55/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="align: right"]$1,306.88[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 2[/TD]
[TD]TT Field[/TD]
[TD]4[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD]$104.55/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="align: right"]$418.20[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 3[/TD]
[TD]Field[/TD]
[TD]15[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$522.75[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 4[/TD]
[TD]Field[/TD]
[TD]37[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$1,289.45[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 5[/TD]
[TD]Field[/TD]
[TD]8[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$30.70/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$245.60[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 6[/TD]
[TD]Field[/TD]
[TD]15[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]$27.95/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, width: 69, align: right"]$419.25[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]John Doe 7[/TD]
[TD]Field[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD="width: 72"]37
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 72"]
<tbody>[TR]
[TD]$34.85/hr[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl66, align: right"]$1,289.45
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


So in this example, the outcome I'm looking for is basically the sum of all unique pay rates. (My workbook is empty after column AI. So we can output any data anywhere after that)

- pay rate 104.55 has 16.5
- Pay rate 34.85 has 89 hours
- pay rate 30.70 has 8 hours
- pay rate 27.95 has 15 hours



My workflow is this..

I get a CSV export from my payroll that looks quite a bit like the example tables above. Then I would take the information from there, copy it into another sheet I use, and count all the hours. Looking to streamline this and be a bit more efficient, because right now I'm using a calculator.. and it takes FOREVER! It'd be really nice if I could just copy and paste it into my range on my sheet, and click a button to auto sum all of the unique pay rates. It would save me several hours a week.

I would really appreciate any help from this!
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Here's my take on a solution.

I used an ArrayList to make sorting and removing duplicates easier. I then converted to an array to make sorting by numbers easier (sorting the ArrayList by text doesn't put the numbers in numerical order).

Code: 
Sub RateTotals()
    Dim payRateRange As Range
    Dim coll As Object, i As Long
    Dim payRates As String, d As Double
    Dim aRatesAsDbl() As Double, totalsRange As Range
    
    Set payRateRange = Range(Range("AG5"), Range("AG5").End(xlDown))
    Set totalsRange = Range("AJ1")

    'Create collection for removing duplicates
    Set coll = CreateObject("System.Collections.ArrayList")
    For i = LBound(payRateRange.value, 1) To UBound(payRateRange.value, 1)
        coll.Add payRateRange(i, 1).value
    Next i
    
    'Remove duplicates
    coll.Sort
    For i = coll.Count - 1 To 1 Step -1
        If coll(i) = coll(i - 1) Then
            coll.RemoveAt i
        End If
    Next i
    
    'Copy to array as numbers
    ReDim aRatesAsDbl(coll.Count - 1)
    For i = coll.Count - 1 To 0 Step -1
        aRatesAsDbl(i) = Mid(coll(i), 2, Len(coll(i)) - 4)
    Next i
    
    'Sort number array in descending order
    Dim sorted As Boolean
    Do While Not sorted
        sorted = True
        For i = 0 To UBound(aRatesAsDbl) - 1
            If aRatesAsDbl(i) < aRatesAsDbl(i + 1) Then
                d = aRatesAsDbl(i)
                aRatesAsDbl(i) = aRatesAsDbl(i + 1)
                aRatesAsDbl(i + 1) = d
                sorted = False
                Exit For
            End If
        Next i
    Loop
    
    'Find totals from sorted numbers
    For i = 0 To UBound(aRatesAsDbl)
        payRates = "$" & aRatesAsDbl(i) & "/hr"
        'Correct string if the zero in the ones place was removed when
        '   converting to double above
        If Mid(payRates, Len(payRates) - 4, 1) = "." Then
            payRates = "$" & aRatesAsDbl(i) & "0/hr"
        End If
        totalsRange.Offset(i, 0).value = payRates
        totalsRange.Offset(i, 1).value = findAllWages(payRateRange, payRates)
    Next i
End Sub

Function findAllHours(findRange As Range, payRate As String) As Double
    Dim FoundCell As Range
    Dim LastCell As Range
    Dim FirstAddr As String
    Dim d As Double
    
    With findRange
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set FoundCell = findRange.Find(what:=payRate, after:=LastCell)
    
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If
    Do Until FoundCell Is Nothing
        d = d + FoundCell.Offset(0, -1).value
        Set FoundCell = findRange.FindNext(after:=FoundCell)
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
    findAllHours = d
End Function
 
Upvote 0
Thank you for the quick response on this! Very well commented too btw. I can't seem to get it working though..

- Made a new command button, pasted code, and I'm getting the function or sub not defined when clicking it... I'm troubleshooting now.. But this is over my head. :) I'll look into it though in the meantime.

Edit: Looks like the line "totalsRange.Offset(i, 1).Value = findAllWages(payRateRange, payRates)" isn't declared. Am I even close? lol! (I'm learning) :D
 
Last edited:
Upvote 0
Yeah, sorry. My bad. I had renamed findAllHours in the HTML code after copying it from Excel but forgot that line. Change the Wages to Hours.
 
Upvote 0
Thank you very much for the help with this. It's amazing. I hope I can pay it forward eventually when I learn more.

I appreciate this immensely. You sir, are a good man! It works exactly as intended!
 
Last edited:
Upvote 0
Just noting that you could probably have made this easier on yourself if, instead of physically putting the "/hr" text into each cell, you had used a Custom Format that displayed it instead... that way, your cells would have contained real numbers that you could easily performed math with. Here is the Custom Format I am thinking of...

$0.00"/hr"

Using it, all you would have to do is type in the number by itself (no $ sign and no trailing text). So, if you entered 12.34 the Custom Format would make it display this way...

$12.34/hr
 
Upvote 0
You're welcome. Glad to help.

Rick's comments might be helpful for you, but I assumed that the CSV you got from finance already had all of the text including the /hr in it. If not, you can see if his comments can additionally help.
 
Upvote 0
shknbk2 said:
You're welcome. Glad to help.

Rick's comments might be helpful for you, but I assumed that the CSV you got from finance already had all of the text including the /hr in it. If not, you can see if his comments can additionally help.
Click to expand...


You were 100% right to assume that it had the "/hr" format in it from the CSV.

Also, I did some testing with this. We have a pay rate that is 42.00 /hr even.. For some reason, the code you gave me is skipping over this one. It seems that if the rate is an even number with a .00 on the end, it won't add it. I did some testing, and it fails to add any numbers together that don't have any "change".

Any chance you know what could be causing this?

Amazing btw. I never thought I would be excited to do billing.... lol!
 
Upvote 0
Any chance you know what could be causing this?
Click to expand...
Yes. I already had accounted for a rate of an even tens in the cents column, but I didn't account for no cents at all. This code fixes that. The problem enters when converting the string to a number. At this point, any trailing zeroes are lost. Therefore, we have to put them back in. That's what the If block in the last For loop does.

Code: 
Sub RateTotals()
    Dim payRateRange As Range
    Dim coll As Object, i As Long
    Dim payRates As String, d As Double
    Dim aRatesAsDbl() As Double, totalsRange As Range
    
    Set payRateRange = Range(Range("AG5"), Range("AG5").End(xlDown))
    Set totalsRange = Range("AJ1")

    'Create collection for removing duplicates
    Set coll = CreateObject("System.Collections.ArrayList")
    For i = LBound(payRateRange.Value, 1) To UBound(payRateRange.Value, 1)
        coll.Add payRateRange(i, 1).Value
    Next i
    
    'Remove duplicates
    coll.Sort
    For i = coll.Count - 1 To 1 Step -1
        If coll(i) = coll(i - 1) Then
            coll.RemoveAt i
        End If
    Next i
    
    'Copy to array as numbers
    ReDim aRatesAsDbl(coll.Count - 1)
    For i = coll.Count - 1 To 0 Step -1
        aRatesAsDbl(i) = Mid(coll(i), 2, Len(coll(i)) - 4)
    Next i
    
    'Sort number array in descending order
    Dim sorted As Boolean
    Do While Not sorted
        sorted = True
        For i = 0 To UBound(aRatesAsDbl) - 1
            If aRatesAsDbl(i) < aRatesAsDbl(i + 1) Then
                d = aRatesAsDbl(i)
                aRatesAsDbl(i) = aRatesAsDbl(i + 1)
                aRatesAsDbl(i + 1) = d
                sorted = False
                Exit For
            End If
        Next i
    Loop
    
    'Find totals from sorted numbers
    For i = 0 To UBound(aRatesAsDbl)
        payRates = "$" & aRatesAsDbl(i) & "/hr"
        'Correct string if the zero in the ones place was removed when
        '   converting to double above
        If Mid(payRates, Len(payRates) - 4, 1) = "." Then
            payRates = "$" & aRatesAsDbl(i) & "0/hr"
        ElseIf InStr(1, payRates, ".") < 1 Then
            payRates = "$" & aRatesAsDbl(i) & ".00/hr"
        End If
        totalsRange.Offset(i, 0).Value = payRates
        totalsRange.Offset(i, 1).Value = findAllHours(payRateRange, payRates)
    Next i
End Sub

Function findAllHours(findRange As Range, payRate As String) As Double
    Dim FoundCell As Range
    Dim LastCell As Range
    Dim FirstAddr As String
    Dim d As Double
    
    With findRange
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set FoundCell = findRange.Find(what:=payRate, after:=LastCell)
    
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If
    Do Until FoundCell Is Nothing
        d = d + FoundCell.Offset(0, -1).Value
        Set FoundCell = findRange.FindNext(after:=FoundCell)
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
    findAllHours = d
End Function
 
Upvote 0
shknbk2 said:
Yes. I already had accounted for a rate of an even tens in the cents column, but I didn't account for no cents at all. This code fixes that. The problem enters when converting the string to a number. At this point, any trailing zeroes are lost. Therefore, we have to put them back in. That's what the If block in the last For loop does.

Code: 
Sub RateTotals()
    Dim payRateRange As Range
    Dim coll As Object, i As Long
    Dim payRates As String, d As Double
    Dim aRatesAsDbl() As Double, totalsRange As Range
    
    Set payRateRange = Range(Range("AG5"), Range("AG5").End(xlDown))
    Set totalsRange = Range("AJ1")

    'Create collection for removing duplicates
    Set coll = CreateObject("System.Collections.ArrayList")
    For i = LBound(payRateRange.Value, 1) To UBound(payRateRange.Value, 1)
        coll.Add payRateRange(i, 1).Value
    Next i
    
    'Remove duplicates
    coll.Sort
    For i = coll.Count - 1 To 1 Step -1
        If coll(i) = coll(i - 1) Then
            coll.RemoveAt i
        End If
    Next i
    
    'Copy to array as numbers
    ReDim aRatesAsDbl(coll.Count - 1)
    For i = coll.Count - 1 To 0 Step -1
        aRatesAsDbl(i) = Mid(coll(i), 2, Len(coll(i)) - 4)
    Next i
    
    'Sort number array in descending order
    Dim sorted As Boolean
    Do While Not sorted
        sorted = True
        For i = 0 To UBound(aRatesAsDbl) - 1
            If aRatesAsDbl(i) < aRatesAsDbl(i + 1) Then
                d = aRatesAsDbl(i)
                aRatesAsDbl(i) = aRatesAsDbl(i + 1)
                aRatesAsDbl(i + 1) = d
                sorted = False
                Exit For
            End If
        Next i
    Loop
    
    'Find totals from sorted numbers
    For i = 0 To UBound(aRatesAsDbl)
        payRates = "$" & aRatesAsDbl(i) & "/hr"
        'Correct string if the zero in the ones place was removed when
        '   converting to double above
        If Mid(payRates, Len(payRates) - 4, 1) = "." Then
            payRates = "$" & aRatesAsDbl(i) & "0/hr"
        ElseIf InStr(1, payRates, ".") < 1 Then
            payRates = "$" & aRatesAsDbl(i) & ".00/hr"
        End If
        totalsRange.Offset(i, 0).Value = payRates
        totalsRange.Offset(i, 1).Value = findAllHours(payRateRange, payRates)
    Next i
End Sub

Function findAllHours(findRange As Range, payRate As String) As Double
    Dim FoundCell As Range
    Dim LastCell As Range
    Dim FirstAddr As String
    Dim d As Double
    
    With findRange
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set FoundCell = findRange.Find(what:=payRate, after:=LastCell)
    
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If
    Do Until FoundCell Is Nothing
        d = d + FoundCell.Offset(0, -1).Value
        Set FoundCell = findRange.FindNext(after:=FoundCell)
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
    findAllHours = d
End Function
Click to expand...

Works perfectly.. Thank you so much!

I love how you explained where and what was causing the issue as well. You're a gentleman and a scholar! Thanks again! This is some really great stuff!

Amazing community & people here!!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Make Ratings Equal Weight Across Factors
Replies
2
Views
272
RoryA
RoryA
K
  • Question Question
AVERAGEIFS / SUMIF with multiple criteria
Replies
3
Views
1K
arthurbr
arthurbr
jski21
  • Question Question
Build Table Based on Cell Values
Replies
0
Views
330
jski21
jski21
E
  • Question Question
Power Query to automate payroll entry
Replies
0
Views
477
egspen2
E
C
  • Solved
Timesheet add a row based on inputbox entry
2
Replies
10
Views
726
cbye
C

Forum statistics

Threads
1,223,886
Messages
6,175,195
Members
452,616
Latest member
intern444

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