copy,paste,calculate Cell value based on calculations & comparisonsother cells same row. Decimal places

**DocAElstein** · 04-18-2020, 03:26 PM

Using simple VBA techniques
' We can find the position of the . using Instr function https://docs.microsoft.com/en-us/off...instr-function
' Then we can take the left of the number for a length equal to the position of the . + 2 using the Left function https://docs.microsoft.com/en-us/off.../left-function
' Then we can remove the . using the Replace function , https://docs.microsoft.com/en-us/off...place-function

Code:

Sub TrimRemoveDot() '  http://www.excelfox.com/forum/showthread.php/2456-Remove-decimals-by-vba?p=13068#post13068
Dim Ws1 As Worksheet
 Set Ws1 = Workbooks("1.xls").Worksheets.Item(1) ' First worksheet in open workbooks 1.xls
 Dim LrK As Long: Let LrK = Ws1.Range("K" & Ws1.Rows.Count & "").End(xlUp).Row
Dim RngK As Range: Set RngK = Ws1.Range("K2:K" & LrK & "")
Dim SnglCel As Range
    For Each SnglCel In RngK
    Dim Pos As Long: Let Pos = InStr(1, SnglCel.Value, ".", vbBinaryCompare)      '    We can find the position of the . using Instr function                                                            https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/instr-function
     Let SnglCel.Value = Left(SnglCel.Value, Pos + 2)                             '    Then we can take the left of the number for a length equal to the position of the . + 2 using the Left function   https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/left-function
     Let SnglCel.Value = Replace(SnglCel.Value, ".", "", 1, -1, vbBinaryCompare)  '    Then we can remove the . using the Replace function                                                               https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/replace-function
    Next SnglCel
End Sub

Or using formulas
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

_Row\^Col	K
1
2	1090.699
3	147.965
4	264.4785
5	30.2495
6

Worksheet: 1-Sheet1
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

_Row\^Col	L	M	N	O
8	=FIND(".",K2)	=LEFT(K2,L8+2)	=SUBSTITUTE(M8,".","")	=SUBSTITUTE(LEFT(K2,FIND(".",K2)+2),".","")
9	=FIND(".",K3)	=LEFT(K3,L9+2)	=SUBSTITUTE(M9,".","")	=SUBSTITUTE(LEFT(K3,FIND(".",K3)+2),".","")
10	=FIND(".",K4)	=LEFT(K4,L10+2)	=SUBSTITUTE(M10,".","")	=SUBSTITUTE(LEFT(K4,FIND(".",K4)+2),".","")
11	=FIND(".",K5)	=LEFT(K5,L11+2)	=SUBSTITUTE(M11,".","")	=SUBSTITUTE(LEFT(K5,FIND(".",K5)+2),".","")

Worksheet: 1-Sheet1
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

_Row\^Col	L	M	N	O
8	5	1090.69	109069	109069
9	4	147.96	14796	14796
10	4	264.47	26447	26447
11	3	30.24	3024	3024

Worksheet: 1-Sheet1

Or using a final formula in Evaluate Range One liner technique

Code:

Sub EvaluateRangeTrimRemoveDot() '  http://www.excelfox.com/forum/showthread.php/2456-Remove-decimals-by-vba?p=13068#post13068
Dim Ws1 As Worksheet
 Set Ws1 = Workbooks("1.xls").Worksheets.Item(1) ' First worksheet in open workbooks 1.xls
 Dim LrK As Long: Let LrK = Ws1.Range("K" & Ws1.Rows.Count & "").End(xlUp).Row
Dim RngK As Range: Set RngK = Ws1.Range("K2:K" & LrK & "")
 Let RngK.Value = Evaluate("=if({1},SUBSTITUTE(LEFT(" & RngK.Address & ",FIND("".""," & RngK.Address & ")+2),""."",""""))")
End Sub