Changing Range of Cell Value Based on Anothr Column Cell

madhuchelliah

Board Regular
Joined
Nov 22, 2017
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
Hello Mates, I have a requirement to change values of range of cells based on another column. It is very very complicated one. Go through the example below. If any of the cell in I column contains EXPIRED word then the below value of corresponding cell value(E3) in E column should change to one level up. It should change value up to next same value of the cell(E2). If the E2 cell contains value 3 then the below values should change one level up, up to next 3 value in E column. Last condition the macros should work if the value 2.....n only. It should not work if the E column have 1 value

INPUT OUTPUT

[TABLE="class: grid, width: 100, align: left"]
<tbody>[TR]
[TD="align: center"]E
[/TD]
[TD="align: center"]I
[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid, width: 100, align: center"]
<tbody>[TR]
[TD="align: center"]E
[/TD]
[TD="align: center"]I
[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD="align: center"]EXPIRED[/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Whoa... that was my very bad...endless loop. Please check your expected output that U last posted. It doesn't seem to follow the rules of the first output. Give this a trial...
Code:
Option Explicit
Sub Test()
Dim Lastrow As Integer, Cnt As Integer, Cnt2 As Integer, Temp As Integer
With Sheets("Sheet1")
    Lastrow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
For Cnt = 1 To Lastrow
If Sheets("Sheet1").Range("E" & Cnt).Value <> 1 Then
If Sheets("Sheet1").Range("I" & Cnt).Value = "EXPIRED" Then
Temp = Sheets("Sheet1").Range("E" & Cnt).Value
Cnt2 = Cnt + 1
Do Until Sheets("Sheet1").Range("I" & Cnt2).Value = "EXPIRED"
If Cnt2 > Lastrow Then
Exit Sub
End If
If Sheets("Sheet1").Range("E" & Cnt2).Value <> Temp Then
Sheets("Sheet1").Range("E" & Cnt2).Value = _
                 Sheets("Sheet1").Range("E" & Cnt2).Value - 1
End If
Cnt2 = Cnt2 + 1
Loop
Cnt = Cnt2 - 1
End If
End If
Next Cnt
End Sub
Dave
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
I don't understand your reply? The code does nothing or same as before but doesn't work for your second set of data? Did U re-check that 2nd set of output data to make sure that is correct? The code posted worked again for the 1st set of data and seemed to work for the 2nd set except the results weren't the same that U posted. Dave
 
Last edited:
Upvote 0
The code is changing the value of 2 to 1 in the last cell of E column. The code should stop there. Am i right?
 
Upvote 0
Yes it should stop there unless U have data in rows below E9?
Your 2nd expected outcome E1:E9 as follows: 1,2,2,2,2,3,3,3,2
This code version output E1:E9 as follows : 1,2,2,2,3,3,3,3,1
The code outputs as expected for the 1st data set and according to the requirements as I understand them outputs the correct values for the 2nd set. Again, have U re-checked your 2nd data set of expected outcomes as posted? Dave
 
Upvote 0
Everything seems fine Dave expect the last vslue changing from 2to1. If the code stops there and let the 2 value as it is(since there is no expired word), then it will be perfect.
 
Upvote 0
It's supposed to turn to 1 being that I5 ("EXPIRED") requires that all rows below E5 subtract 1 from there value until the next "EXPIRED" unless the value is the same as E5 which is 3. 2-1=1. So I'm not sure why U want the last value to be 2? Dave
 
Upvote 0
Hey Dave whatever you told are correct only. i want to add one more point with this line "turn to 1 being that I5 ("EXPIRED") requires that all rows below E5 subtract 1 from there value until the next "EXPIRED" unless the value is the same as E5 which is 3. 2-1=1". It should subtract only the value greater than of E5. The E5 value is 3 its is greater than 2 so need to subtract. Totally three conditions to stop the code.
1. It should stop when it finds Expired word
2. It should stop before the same value
3. It should stop if the value is less than the value of expired cell.
 
Upvote 0
Code:
Option Explicit
Sub Test()
Dim Lastrow As Integer, Cnt As Integer, Cnt2 As Integer, Temp As Integer
With Sheets("Sheet1")
    Lastrow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
For Cnt = 1 To Lastrow
If Sheets("Sheet1").Range("E" & Cnt).Value <> 1 Then
If Sheets("Sheet1").Range("I" & Cnt).Value = "EXPIRED" Then
Temp = Sheets("Sheet1").Range("E" & Cnt).Value
Cnt2 = Cnt + 1
Do Until Sheets("Sheet1").Range("I" & Cnt2).Value = "EXPIRED"
If Cnt2 > Lastrow Then
Exit Sub
End If
If (Sheets("Sheet1").Range("E" & Cnt2).Value <> Temp) And _
        (Sheets("Sheet1").Range("E" & Cnt2).Value > Temp) Then
Sheets("Sheet1").Range("E" & Cnt2).Value = _
                 Sheets("Sheet1").Range("E" & Cnt2).Value - 1
End If
Cnt2 = Cnt2 + 1
Loop
Cnt = Cnt2 - 1
End If
End If
Next Cnt
End Sub
Seems to work. Dave
 
Upvote 0
Hello Dave, The code is not working if the cell contains any other words along with EXPIRED. The code suppose to work if the cell contains EXPIRED not equal to EXPIRED. If i am getting EXPIRED word continuously the code is not working properly. Check the table below. 1st one is scenario 2nd one is the result i got 3rd one is the expected result. The meaning of EXPIRED is the value in E column is no more valid. Here 2 and 3 both are getting invalid so the 4 should be move to 2. Please look into it. Thank you.


[TABLE="class: grid, width: 100, align: center"]
<tbody>[TR]
[TD]E
[/TD]
[TD]I
[/TD]
[TD][/TD]
[TD]E
[/TD]
[TD]I
[/TD]
[TD][/TD]
[TD]E
[/TD]
[TD]I
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]EXPIRED
[/TD]
[TD][/TD]
[TD]2
[/TD]
[TD]EXPIRED
[/TD]
[TD][/TD]
[TD]2
[/TD]
[TD]EXPIRED
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]EXPIRED
[/TD]
[TD][/TD]
[TD]3
[/TD]
[TD]EXPIRED
[/TD]
[TD][/TD]
[TD]2
[/TD]
[TD]EXPIRED
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[TD]3
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[TD]3
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[TD]3
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top