# Find and Replace

#### MyersEPS

##### New Member
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

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

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

#### MyersEPS

##### New Member
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
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

#### MyersEPS

##### New Member
Like a champ, perfect, thanks.

#### MyersEPS

##### New Member
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
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
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

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
That worked, but is there a way to have it ignore formulas or give it a range to perform the vba?