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

**fixer** · 04-17-2020, 02:01 PM

“Moderator” Notice
September 2020
Given up with this “OP” , Avinash around September 2020. https://excelfox.com/forum/showthrea...ll=1#post14972
https://excelfox.com/forum/showthrea...ll=1#post14972
I am no longer monitoring what its doings. It had curiosity appeal for a while, but even that has worn off me now!
It’s getting worse by the Day. Its still doing whatever it is that it is doing and getting Replies and answers at excelforum.com and likely a few places I don’t know about.

vba code will be placed in a seperate file macro.xlsm
i have one more file 1.xls (all files are located in a different path)
i have attached a sample pic of 1.xls & result pic too
check if Column H is greater or lower than column D
if column H is greater than column D then calculate 1% of column H and paste it to column J and then subtract Column H & column J and paste the result to column K
Or
if column H is lower than column D then calculate 1% of column H and paste it to column J and then add Column H & column J and paste the result to column K
Plz help me in solving this problem sir

Almost the same as from MoldyBread at excelforum
https://www.excelforum.com/excel-pro...ml#post5338184

Some more recent cross posted duplicsate on another one of Avinashes infinite cycles of starting again
https://eileenslounge.com/viewtopic.php?f=30&t=34932
https://chandoo.org/forum/threads/pu...9/#post-266257 ( Leonardo1234 starting again )

**DocAElstein** · 04-17-2020, 10:04 PM

This is so simple, that even I find it easy to do, with a formula...

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

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1087	1030	955.5	998.45	1079.9	22	=IF(H2>D2,1/100*H2,IF(H2))	=IF(H2>D2,H2-J2,IF(H2))
3	NSE	ADANIPOWER	EQ	148.05	27.75	25.65	25.65	146.5	25	=IF(H3>D3,1/100*H3,IF(H3))	=IF(H3>D3,H3-J3,IF(H3))
4	NSE	DLF	EQ	265	419.7	350.05	387.25	267.15	17388	=IF(H4>D4,1/100*H4,IF(H4))	=IF(H4>D4,H4-J4,IF(H4))
5	NSE	AMBUJACEM	EQ	30.4	155.8	142.55	145.85	29.95	15083	=IF(H5>D5,1/100*H5,IF(H5))	=IF(H5>D5,H5-J5,IF(H5))

Worksheet: 1-Sheet1

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

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1087	1030	955.5	998.45	1079.9	22	=IF(H2>D2,1/100*H2,IF(H2))	=IF(H2>D2,H2-J2,IF(H2))
3	NSE	ADANIPOWER	EQ	148.05	27.75	25.65	25.65	146.5	25	=IF(H3>D3,1/100*H3,IF(H3))	=IF(H3>D3,H3-J3,IF(H3))
4	NSE	DLF	EQ	265	419.7	350.05	387.25	267.15	17388	=IF(H4>D4,1/100*H4,IF(H4))	=IF(H4>D4,H4-J4,IF(H4))
5	NSE	AMBUJACEM	EQ	30.4	155.8	142.55	145.85	29.95	15083	=IF(H5>D5,1/100*H5,IF(H5))	=IF(H5>D5,H5-J5,IF(H5))

Worksheet: 1-Sheet1

Each formula uses 2 Excel If functions, one is nested in the other...

Code:

(    If  _>_   , Do this ,  Else [ If _<_ , Do this  , Else "......"    ]    )

    If ( _>_   , Do this ,  Else  If( _<_ , Do this  , Else "......"    )    )

Column J

Code:

  =IF(H2>D2,1/100*H2,IF(H2)

 if column H is greater than column D then calculate 1% of column H
  =IF(H2>D2,1/100*H2,
                     Else
           if column H is lower than column D then calculate 1% of column H
                     IF(H2Else
                                       "D is equal to H"))

Column K

Code:

  =IF(H2>D2,H2-J2,IF(H2)

 if column H is greater than column D subtract Column H & column J
  =IF(H2>D2,H2-J2,
                  Else
           if column H is lower than column D  add Column H & column J
                  IF(H2Else
                                   "D is equal to H"))

Alan

Ref
https://support.office.com/en-us/art...rs=en-US&ad=US
https://www.techonthenet.com/excel/formulas/if.php

**fixer** · 04-17-2020, 11:18 PM

Code:

Sub STEP8()
  Dim Wb1 As Workbook, Ws1 As Worksheet, Lr1 As Long
  Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
  Set Ws1 = Wb1.Worksheets.Item(1)
  Let Lr1 = Ws1.Range("H" & Ws1.Rows.Count).End(xlUp).Row
   Ws1.Range("J2:J" & Lr1 & "").Value = "=IF(H2>D2,1/100*H2,IF(H2

Doc Sir i am getting error sir i dont know why i got it plz have a look sir

**DocAElstein** · 04-18-2020, 02:07 AM

Hi
Your macro is very good.
You have written good coding.
It is almost perfect.

There is just one very small problem. It is just because VBA is confused when quotes are inside quotes. VBA does not like to see quotes inside other quotes. It get confused.

If VBA see this: …_

Code:

    "     "     "

_.. VBA does not know what it is. VBA thinks maybe it is either this

Code:

    "     "     "

or this

Code:

    "     "     "

VBA does not like to see inside quotes 1 quote or 3 quotes or 5 quotes … etc

VBA must always see 2 quotes "" ( or 4 quotes m"""", or 6 quotes """""" )etc..
We must do a trick , like this

Code:

    "     ""    "

Or this:

Code:

    "     ""    ""    "

If you do this trick, then VBA will see for "" just one quote.

So in your macro , like this is the problem: "________"_D is equal to H_"____"

Code:

"=IF(H2>D2,1/100*H2,IF(H2"D is equal to H"))"

We must do trick: "________""_D is equal to H_""____"

Code:

"=IF(H2>D2,1/100*H2,IF(H2""D is equal to H""))"

So in your macro,
change the single quotes inside the outermost enclosing quotes to double quotes
like this:
______________Ws1.Range(" 2: " & Lr1 & "").Value =__"__________""_D is equal to H_""____"

Code:

Sub STEP8()
  Dim Wb1 As Workbook, Ws1 As Worksheet, Lr1 As Long
  Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
  Set Ws1 = Wb1.Worksheets.Item(1)
  Let Lr1 = Ws1.Range("H" & Ws1.Rows.Count).End(xlUp).Row
   Ws1.Range("J2:J" & Lr1 & "").Value = "=IF(H2>D2,1/100*H2,IF(H2""D is equal to H""))"
   Ws1.Range("J2:J" & Lr1 & "").Value = Ws1.Range("J2:J" & Lr1 & "").Value
   Ws1.Range("K2:K" & Lr1 & "").Value = "=IF(H2>D2,H2-J2,IF(H2""D is equal to H""))"
   Ws1.Range("K2:K" & Lr1 & "").Value = Ws1.Range("K2:K" & Lr1 & "").Value
   Wb1.Save
   Wb1.Close
End Sub

You did almost perfect in your macro. It was very close.

Alan

http://www.eileenslounge.com/viewtopic.php?f=30&t=34670

**fixer** · 04-18-2020, 09:30 AM

I will place the macro in a seperate file macro.xlsm
and i have a file name 1.xls
in 1.xls in column K i have data (i have attached the sample pic of that)
what i need is i need a macro that will remove third number after decimal and along with it it should remove the decimal
Result will be
1090.699 after runing the macro the ouput will be 109069
147.965 after runing the macro the ouput will be 14796
264.4785 after runing the macro the ouput will be 26447
30.2495 after runing the macro the ouput will be 3024

plz help me in solving this problem by vba

**fixer** · 04-18-2020, 10:36 AM

Thnx Alot Doc Sir for helping me in solving this problem

**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

Alan

Some more recent cross posted duplicsate on another one of Avinashes infinite cycles of starting again
https://eileenslounge.com/viewtopic.php?f=30&t=34932
https://chandoo.org/forum/threads/pu...9/#post-266257 ( Leonardo1234 starting again )

**fixer** · 04-18-2020, 04:06 PM

Thnx Alot Doc Sir for ur Great Support
Problem Solved

**fixer** · 04-18-2020, 05:18 PM

all file are located in a different path
vba code will be placed in a seperate file macro.xlsm
my file name is 1.xls
If column H of 1.xls is lower than column D of 1.xls then with column K (subtract it and make it to the number ending with 0 or 5 whichever met first)
If column H of 1.xls is greater than column D of 1.xls then with column K (add it and make it to the number ending with 0 or 5 whichever met first)
i have attached the sample file and result too.. plz have a look sir
and help me in solving this problem sir

**sandy666** · 04-19-2020, 02:36 AM

just for fun with Power Query

Code:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Split = Table.SplitColumn(Table.TransformColumnTypes(Source, {{"raw", type text}}, "en-GB"), "raw", Splitter.SplitTextByDelimiter(".", QuoteStyle.Csv), {"raw.1", "raw.2"}),
    Extract = Table.TransformColumns(Split, {{"raw.2", each Text.Start(Text.From(_, "en-GB"), 2), type text}}),
    Merge = Table.CombineColumns(Table.TransformColumnTypes(Extract, {{"raw.1", type text}}, "en-GB"),{"raw.1", "raw.2"},Combiner.CombineTextByDelimiter("", QuoteStyle.None),"Result"),
    Type = Table.TransformColumnTypes(Merge,{{"Result", Int64.Type}})
in
    Type