Results 1 to 7 of 7

Thread: Add Remark in cloumn based on calculation/comparisons in one worksheet

  1. #1
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Add Remark in cloumn based on calculation/comparisons in one worksheet

    all files are located in a different path
    vba macro will be placed in a seperate file
    this macro
    We have to look at S10 value, how much value S10 has
    after knowing the S10 value, we will start adding the data in column Q till we reached the S10 value(or till we reach the value near to S10)But not greater than S10
    example
    in this sample file
    S10 value is 1000
    So we will add the value of column Q , So From Q2 to Q6 the total value is reached to 989.575 (close to S10 value 1000)
    If We add the data ahead, then from Q2 TO Q7 the total value is 1061.53, Since it is greater than the value of S10 ,we cant consider Q2 to Q7
    So we consider Q2 TO Q6(which is near to S10 , but not greater than S10 value)
    Since we consider the Q2 to Q6, then we will put a remark in column J as 1(Since we consider the Q2 TO Q6 then we will put a remark in J2 to J6 as 1)

    Column J is the result that i need when i ran the macro
    So Plz have a look and do needful
    Attached Files Attached Files
    Last edited by DocAElstein; 06-25-2020 at 01:07 PM. Reason: Opened Thread

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Before

    _____ Workbook: Book1.xlsm ( Using Excel 2007 32 bit )
    Row\Col
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    R
    S
    T
    1
    LTP
    2
    63.3
    1
    60
    1.055
    1.055
    54
    156.97
    3
    56.65
    6
    60
    0.94417
    5.665
    54
    550.985
    4
    65.65
    6
    60
    1.09417
    6.565
    54
    59.085
    5
    73.05
    1
    60
    1.2175
    1.2175
    54
    165.745
    6
    63.1
    6
    60
    1.05167
    6.31
    54
    56.79
    7
    79.95
    6
    60
    1.3325
    7.995
    54
    71.955
    8
    27.55
    1
    60
    0.45917
    0.45917
    54
    24.795
    8000
    9
    87.9
    1
    60
    1.465
    1.465
    54
    79.11
    9000
    10
    81.65
    6
    51
    1.60098
    9.60588
    54
    86.4529
    Profit Amount
    1000
    11
    67.9
    1
    60
    1.13167
    1.13167
    54
    61.11
    12
    Worksheet: Sheet1

    Results After running macro

    _____ Workbook: Book1.xlsm ( Using Excel 2007 32 bit )
    Row\Col
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    R
    S
    T
    1
    LTP
    2
    63.3
    1
    1
    60
    1.055
    1.055
    54
    156.97
    3
    56.65
    1
    6
    60
    0.94417
    5.665
    54
    550.985
    4
    65.65
    1
    6
    60
    1.09417
    6.565
    54
    59.085
    5
    73.05
    1
    1
    60
    1.2175
    1.2175
    54
    165.745
    6
    63.1
    1
    6
    60
    1.05167
    6.31
    54
    56.79
    7
    79.95
    6
    60
    1.3325
    7.995
    54
    71.955
    8
    27.55
    1
    60
    0.45917
    0.45917
    54
    24.795
    8000
    9
    87.9
    1
    60
    1.465
    1.465
    54
    79.11
    9000
    10
    81.65
    6
    51
    1.60098
    9.60588
    54
    86.4529
    Profit Amount
    1000
    11
    67.9
    1
    60
    1.13167
    1.13167
    54
    61.11
    12
    Worksheet: Sheet1


    Code:
    '     https://excelfox.com/forum/showthread.php/2489-Calculation-amp-Remark
    '
    Sub CalculationAndRemark()
    Rem 1 Worksheets info
    Dim Wb As Workbook
     Set Wb = Workbooks("Book1.xlsm") ' change to suit
    Dim Ws1 As Worksheet: Set Ws1 = Wb.Worksheets.Item(1)
    Dim rngIn As Range: Set rngIn = Ws1.Range("A1:S11")
    Dim arrIn() As Variant, arrOut() As Variant: Let arrIn() = rngIn.Value2
    Dim S10Val As Double: Let S10Val = arrIn(10, 19)
    Rem 2 Do it untill we are past 1000
     Let arrOut() = arrIn()
    Dim Cnt As Long, SomeTotal As Double
     Let Cnt = 2: Let SomeTotal = arrIn(Cnt, 17)
        Do
         Let arrOut(Cnt, 10) = 1
         Let Cnt = Cnt + 1
         Let SomeTotal = SomeTotal + arrIn(Cnt, 17)
        Loop While SomeTotal < S10Val
    Rem 3 Output
     Let rngIn.Value2 = arrOut()
    
    
    End Sub
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  3. #3
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    I am getting error with This line Doc Sir plz have a look details has been attached
    Attached Images Attached Images
    Attached Files Attached Files

  4. #4
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    The last row is hard coded to 11 –
    Ws1.Range("A1:S11")

    You need to make the last row dynamic. You should know how to do that. ( http://www.excelfox.com/forum/showth...ll=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. ) )
    Try first yourself. If you have difficulties I will help again later
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  5. #5
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    I tried & No doubt i am facing difficulties in making the lr dynamic but I promise next time if u ask me to do so then No doubt u will get the answer from me Doc Sir
    Attached Images Attached Images

  6. #6
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Before:
    _____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    1
    LTP
    2
    63.3
    1
    60
    1.055
    1.055
    54
    56.97
    3
    56.65
    6
    60
    0.94417
    5.665
    54
    50.985
    4
    65.65
    6
    60
    1.09417
    6.565
    54
    59.085
    5
    73.05
    1
    60
    1.2175
    1.2175
    54
    65.745
    6
    63.1
    6
    60
    1.05167
    6.31
    54
    56.79
    7
    79.95
    6
    60
    1.3325
    7.995
    54
    71.955
    8
    27.55
    1
    60
    0.45917
    0.45917
    54
    24.795
    9
    87.9
    1
    60
    1.465
    1.465
    54
    79.11
    10
    81.65
    6
    51
    1.60098
    9.60588
    54
    86.4529
    11
    67.9
    1
    60
    1.13167
    1.13167
    54
    61.11
    12
    27
    1
    58
    0.46552
    0.46552
    54
    25.1379
    13
    18.4
    6
    42
    0.4381
    2.62857
    54
    23.6571
    14
    22.15
    6
    40
    0.55375
    3.3225
    54
    29.9025
    15
    72.05
    1
    55
    1.31
    1.31
    54
    70.74
    16
    94.35
    1
    60
    1.5725
    1.5725
    54
    84.915
    17
    62.5
    6
    60
    1.04167
    6.25
    54
    56.25
    18
    40.35
    6
    60
    0.6725
    4.035
    54
    36.315
    Worksheet: Sheet1

    After

    _____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    1
    LTP
    2
    63.3
    1
    1
    60
    1.055
    1.055
    54
    56.97
    3
    56.65
    1
    6
    60
    0.94417
    5.665
    54
    50.985
    4
    65.65
    1
    6
    60
    1.09417
    6.565
    54
    59.085
    5
    73.05
    1
    1
    60
    1.2175
    1.2175
    54
    65.745
    6
    63.1
    1
    6
    60
    1.05167
    6.31
    54
    56.79
    7
    79.95
    1
    6
    60
    1.3325
    7.995
    54
    71.955
    8
    27.55
    1
    1
    60
    0.45917
    0.45917
    54
    24.795
    9
    87.9
    1
    1
    60
    1.465
    1.465
    54
    79.11
    10
    81.65
    1
    6
    51
    1.60098
    9.60588
    54
    86.4529
    11
    67.9
    1
    1
    60
    1.13167
    1.13167
    54
    61.11
    12
    27
    1
    1
    58
    0.46552
    0.46552
    54
    25.1379
    13
    18.4
    1
    6
    42
    0.4381
    2.62857
    54
    23.6571
    14
    22.15
    1
    6
    40
    0.55375
    3.3225
    54
    29.9025
    15
    72.05
    1
    1
    55
    1.31
    1.31
    54
    70.74
    16
    94.35
    1
    1
    60
    1.5725
    1.5725
    54
    84.915
    17
    62.5
    1
    6
    60
    1.04167
    6.25
    54
    56.25
    18
    40.35
    1
    6
    60
    0.6725
    4.035
    54
    36.315
    19
    287.65
    6
    60
    4.79417
    28.765
    54
    258.885
    Worksheet: Sheet1

    Code:
    Sub CalculationAndRemark()
    Rem 1 Worksheets info
    Dim Wb As Workbook
     Set Wb = Workbooks("Actual File.xlsx")   '  Workbooks("Book1.xlsm") ' change to suit
    Dim Ws1 As Worksheet: Set Ws1 = Wb.Worksheets.Item(1)
    Dim Lr As Long
     Let Lr = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Dim rngIn As Range: Set rngIn = Ws1.Range("A1:S" & Lr & "")
    Dim arrIn() As Variant, arrOut() As Variant: Let arrIn() = rngIn.Value2
    Dim S10Val As Double: Let S10Val = arrIn(10, 19)
    Rem 2 Do it untill we are past 1000
     Let arrOut() = arrIn()
    Dim Cnt As Long, SomeTotal As Double
     Let Cnt = 2: Let SomeTotal = arrIn(Cnt, 17)
        Do
         Let arrOut(Cnt, 10) = 1
         Let Cnt = Cnt + 1
         Let SomeTotal = SomeTotal + arrIn(Cnt, 17)
        Loop While SomeTotal < S10Val
    Rem 3 Output
     Let rngIn.Value2 = arrOut()
    End Sub
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  7. #7
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Awesome Doc Sir, Thnx Alot for helping me in Solving the same
    Next time If there will be Any Lr issue then i will take care of that

Similar Threads

  1. Replies: 74
    Last Post: 09-07-2020, 01:06 PM
  2. Replies: 24
    Last Post: 04-18-2020, 10:36 AM
  3. TAT Calculation
    By pramodagroiya in forum Excel Help
    Replies: 5
    Last Post: 05-30-2016, 12:27 PM
  4. On Going Calculation
    By justme1052 in forum Excel Help
    Replies: 2
    Last Post: 12-31-2013, 02:06 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •