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

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​
1​	Mintues	Truncated decimal	TRUE​		Value	Decimal	Corrected			FORMULA
2​	1​	0.01​	0.017​		1.16​	0.16​	1.167​		in B2 copied down to B60	=TRUNC(A2/60*100)/100
3​	2​	0.03​	0.033​						in C2 copied down to C60	=ROUND(A2/60,3)
4​	3​	0.05​	0.05​						in F2	=TRUNC(100*(E2-TRUNC(E2)))/100
5​	4​	0.06​	0.067​						in G2	=TRUNC(E2)+VLOOKUP(F2,B:C,2,1)
6​	5​	0.08​	0.083​
7​	6​	0.1​	0.1​
8​	7​	0.11​	0.117​
9​	8​	0.13​	0.133​
10​	9​	0.15​	0.15​
11​	10​	0.16​	0.167​
12​	11​	0.18​	0.183​
13​	12​	0.2​	0.2​
14​	13​	0.21​	0.217​
15​	14​	0.23​	0.233​
16​	15​	0.25​	0.25​
17​	16​	0.26​	0.267​
18​	17​	0.28​	0.283​
19​	18​	0.3​	0.3​

Sheet: Sheet1

 

[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

	D​	E​
1​	Orig	New
2​	8.01​	8.017​
3​	9.03​	9.033​
4​	0.05​	0.05​
5​	4.06​	4.067​
6​	10.08​	10.083​
7​	5.1​	5.1​
8​	1.11​	1.117​
9​	0.13​	0.133​
10​	7.15​	7.167​
11​	3.16​	3.167​
12​	9.18​	9.183​
13​	5.2​	5.217​
14​	8.21​	8.217​
15​	2.23​	2.233​
16​	3.25​	3.25​
17​	10.26​	10.267​
18​	6.28​	6.283​
19​	2.3​	2.3​
20​	0.31​	0.317​

Sheet: Sheet1

 

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