Find and Replace

[MyersEPS]

Hello,

I am trying to find and replace 2 place decimals numbers in a column with 3 place decimals using vba. The problem is that some of the numbers are over an hour (1.16 should be 1.167) in time. I tired using wildcards, but it seems to put the wildcard character in with the number. Any help would be appreciated.

Thanks

 

[Yongle]

Are you trying to accomplish value as converted in G2 with VBA?

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]

A​

[/th][th]

B​

[/th][th]

C​

[/th][th]

D​

[/th][th]

E​

[/th][th]

F​

[/th][th]

G​

[/th][th]

H​

[/th][th]

I​

[/th][th]

J​

[/th][th]

K​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

1​

[/td][td] Mintues[/td][td] Truncated
decimal[/td][td]

TRUE​

[/td][td][/td][td] Value[/td][td] Decimal[/td][td] Corrected[/td][td][/td][td][/td][td] FORMULA[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

2​

[/td][td]

1​

[/td][td]

0.01​

[/td][td]

0.017​

[/td][td][/td][td]

1.16​

[/td][td]

0.16​

[/td][td]

1.167​

[/td][td][/td][td] in B2 copied down to B60[/td][td] =TRUNC(A2/60*100)/100[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

3​

[/td][td]

2​

[/td][td]

0.03​

[/td][td]

0.033​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td] in C2 copied down to C60[/td][td] =ROUND(A2/60,3)[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

4​

[/td][td]

3​

[/td][td]

0.05​

[/td][td]

0.05​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td] in F2[/td][td] =TRUNC(100*(E2-TRUNC(E2)))/100[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

5​

[/td][td]

4​

[/td][td]

0.06​

[/td][td]

0.067​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td] in G2[/td][td] =TRUNC(E2)+VLOOKUP(F2,B:C,2,1)[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

6​

[/td][td]

5​

[/td][td]

0.08​

[/td][td]

0.083​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

7​

[/td][td]

6​

[/td][td]

0.1​

[/td][td]

0.1​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

8​

[/td][td]

7​

[/td][td]

0.11​

[/td][td]

0.117​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

9​

[/td][td]

8​

[/td][td]

0.13​

[/td][td]

0.133​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

10​

[/td][td]

9​

[/td][td]

0.15​

[/td][td]

0.15​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

11​

[/td][td]

10​

[/td][td]

0.16​

[/td][td]

0.167​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

12​

[/td][td]

11​

[/td][td]

0.18​

[/td][td]

0.183​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

13​

[/td][td]

12​

[/td][td]

0.2​

[/td][td]

0.2​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

14​

[/td][td]

13​

[/td][td]

0.21​

[/td][td]

0.217​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

15​

[/td][td]

14​

[/td][td]

0.23​

[/td][td]

0.233​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

16​

[/td][td]

15​

[/td][td]

0.25​

[/td][td]

0.25​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

17​

[/td][td]

16​

[/td][td]

0.26​

[/td][td]

0.267​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

18​

[/td][td]

17​

[/td][td]

0.28​

[/td][td]

0.283​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

19​

[/td][td]

18​

[/td][td]

0.3​

[/td][td]

0.3​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]

 

[Yongle]

In post#2 I should have explained that the decimal part of the time value in E2 is replaced with the correct decimal (rounded to 3 places) by looking up the value in column B and replacing with the value in column C

So take the 1.16
Deduct the 1
Leaving 0.16
Look that up in column B
Replace with 0.167 (value in column C)
Add back the 1

TRUNC used a few times in the formula to eliminate rounding differences

 

[MyersEPS]

Yes, we have data entry personal and I want to save them time by not having to enter the 3 place decimal, but I want to be able to run vba to make the decimal correct. Thanks.

 

[Yongle]

With Data to be replaced in column D starting in D2 - amend to match the column containing your data
Resultant values put in adjacent column for testing - to replace original values by amend like this

[COLOR=#ff0000]cel[/COLOR] = Hrs + calcDecml

Sub ValueReplace()

Dim Hrs As Integer, M As Integer, Valu As Double, Decml As Double, calcDecml As Double, cel As Range, Rng As Range
With ActiveSheet
    Set Rng = .Range("[B]D2[/B]", .Range("[B]D[/B]" & Rows.Count).End(xlUp))
End With

For Each cel In Rng
    Valu = cel.Value:   Hrs = Fix(Valu):    Decml = Valu - Hrs
    For M = 0 To 59
        calcDecml = Round(M / 60, 3)
        If Decml <= calcDecml Then
            [COLOR=#ff0000]cel.Offset(, 1)[/COLOR] = Hrs + calcDecml
            Exit For
        End If
    Next M
Next cel
End Sub

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]

D​

[/th][th]

E​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

1​

[/td][td]Orig[/td][td]New[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

2​

[/td][td]

8.01​

[/td][td]

8.017​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

3​

[/td][td]

9.03​

[/td][td]

9.033​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

4​

[/td][td]

0.05​

[/td][td]

0.05​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

5​

[/td][td]

4.06​

[/td][td]

4.067​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

6​

[/td][td]

10.08​

[/td][td]

10.083​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

7​

[/td][td]

5.1​

[/td][td]

5.1​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

8​

[/td][td]

1.11​

[/td][td]

1.117​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

9​

[/td][td]

0.13​

[/td][td]

0.133​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

10​

[/td][td]

7.15​

[/td][td]

7.167​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

11​

[/td][td]

3.16​

[/td][td]

3.167​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

12​

[/td][td]

9.18​

[/td][td]

9.183​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

13​

[/td][td]

5.2​

[/td][td]

5.217​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

14​

[/td][td]

8.21​

[/td][td]

8.217​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

15​

[/td][td]

2.23​

[/td][td]

2.233​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

16​

[/td][td]

3.25​

[/td][td]

3.25​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

17​

[/td][td]

10.26​

[/td][td]

10.267​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

18​

[/td][td]

6.28​

[/td][td]

6.283​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

19​

[/td][td]

2.3​

[/td][td]

2.3​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

20​

[/td][td]

0.31​

[/td][td]

0.317​

[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]

 

[MyersEPS]

Like a champ, perfect, thanks.

 

[MyersEPS]

I spoke to fast, when it finds a empty cell it put a .000 in there. Any way to skip blanks?

 

[Yongle]

This ignores zeros and blanks

Sub ValueReplace()

Dim Hrs As Integer, M As Integer, Valu As Double, Decml As Double, calcDecml As Double, cel As Range, Rng As Range
With ActiveSheet
    Set Rng = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
End With

For Each cel In Rng
    Valu = cel.Value
    If Valu <> 0 Then
        Hrs = Fix(Valu):   Decml = Valu - Hrs
        For M = 0 To 59
            calcDecml = Round(M / 60, 3)
            If Decml <= calcDecml Then
                cel.Offset(, 1) = Hrs + calcDecml
                Exit For
            End If
        Next M
    End If
Next cel
End Sub

 

[Yongle]

I occurred to me that time values could be negative but I had only been tested with positive values
- here is a minor mod to allows for that

Sub ValueReplace()
    Dim Hrs As Integer, M As Integer, Valu As Double, Decml As Double, calcDecml As Double, cel As Range, Rng As Range
    With ActiveSheet
        Set Rng = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
    End With
    
    For Each cel In Rng
        Valu = cel.Value
        If Valu <> 0 Then
            Hrs = Fix(Valu):   Decml = Valu - Hrs
            For M = 0 To 59
                calcDecml = Round(M / 60, 3)
                If [COLOR=#ff0000]Abs(Decml)[/COLOR] <= calcDecml Then
                   [COLOR=#ff0000] If Valu < 0 Then calcDecml = -calcDecml[/COLOR]
                    cel.Offset(, 1) = Hrs + calcDecml
                    Exit For
                End If
            Next M
        End If
    Next cel
End Sub

 

[MyersEPS]

That worked, but is there a way to have it ignore formulas or give it a range to perform the vba?