Find and Replace

MyersEPS

New Member
Joined
Nov 2, 2018
Messages
14
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
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,015
Office Version
365
Platform
Windows
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

Well-known Member
Joined
Mar 11, 2015
Messages
6,015
Office Version
365
Platform
Windows
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

New Member
Joined
Nov 2, 2018
Messages
14
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

Well-known Member
Joined
Mar 11, 2015
Messages
6,015
Office Version
365
Platform
Windows
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
Code:
[COLOR=#ff0000]cel[/COLOR] = Hrs + calcDecml
Code:
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
OrigNew
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

New Member
Joined
Nov 2, 2018
Messages
14
I spoke to fast, when it finds a empty cell it put a .000 in there. Any way to skip blanks?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,015
Office Version
365
Platform
Windows
This ignores zeros and blanks

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

Well-known Member
Joined
Mar 11, 2015
Messages
6,015
Office Version
365
Platform
Windows
I occurred to me that time values could be negative but I had only been tested with positive values :eek:
- here is a minor mod to allows for that

Code:
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
 
Last edited:

MyersEPS

New Member
Joined
Nov 2, 2018
Messages
14
That worked, but is there a way to have it ignore formulas or give it a range to perform the vba?
 

Watch MrExcel Video

Forum statistics

Threads
1,099,082
Messages
5,466,537
Members
406,485
Latest member
kaksolver

This Week's Hot Topics

Top