How to improve below mentioned code

[ThrottleWorks]

How to improve below mentioned code. Please note I will be uploading a sample file shortly (Only then the code will make any sense).

'Copying and spliting multiple records
        Dim FreqRng As Range
        Set FreqRng = TempSht.Range(TempSht.Cells(2, 12), TempSht.Cells(TempLr, 12))
        'FreqRng.Select
        For Each Rng In FreqRng
            TLr = Data.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Rng.Offset(0, -11).Select
            ActiveCell.Resize(1, 9).Copy
            TempSht.Range(TempSht.Cells(1, 16), TempSht.Cells(Rng + 1, 16)).PasteSpecial
            FreqLr = TempSht.Cells(Rows.Count, 16).End(xlUp).Row
            TempSht.Range(TempSht.Cells(1, 21), TempSht.Cells(Rng, 21)).Value = Rng.Offset(0, 1)
            TempSht.Cells(FreqLr, 21).Value = Rng.Offset(0, 2)
            TempSht.Range("P1").CurrentRegion.Copy Destination:=Data.Cells(TLr, 1)
            TempSht.Range("P1").CurrentRegion.Clear
        Next

 

[ThrottleWorks]

Now let me try to explain what I am trying to achieve.
I have data in Sheet1 of a file, I need to copy this data with some conditions in sheet 2 of the same file.

Range I2 value = 25054. This is greater than 25,000.
Range J2 formula =I3/25000

Now I find the position of decimal point in Range K2 with =SEARCH(".",J3)
To get the whole number I use =LEFT(J3,K3-1) in Range L2.
Range M2 =L3*25000
Range N2 =I3-M3 which is 54.

So I need 2 rows for this particular record.
Range X3 = 25000
Range X4 = 54

Sum of X3 and X4 is 25054 which is matching with my first record.
From Column A:H data remains the same, only case is I need to split amount in Column I in multiples of 25,000.

 

[Marc L]

Hi !

Let start with I2 cell = 57893 :

• N2 formula : =MOD(I2,25000) (aka 7893) …

• M2 formula : =I2-N2 (aka 50000) …

But here it's the VBA forum : so what do you really need ?
​

 

[ThrottleWorks]

Hi @Marc L , thanks a lot for the help. The code is running okay, my problem is I don't think it's a good code. I was trying to get the suggestions to better this code. This is not urgent though.

Have a nice week ahead.

PS - Sorry for late reply.

 

[p45cal]

see attached

 

[ThrottleWorks]

Hi @p45cal , thanks a lot for the help. I am checking this and will revert with details. Have a nice day ahead.

 

[ThrottleWorks]

Hi @p45cal , you are awesome sir !