VBA to help change the value from 1 to 0 based on a value of another cell

U

UmairKamal

New Member
Joined
Aug 27, 2021
Messages
17
Office Version
  1. 2016
  2. 2013
Platform
  1. Windows
Dear Users,

I have the following dataset. If the values in column A are duplicate, and if the value in Column D has the wording "Review" in it, then the number in column E for the first result are converted to zero.

ReferenceDecision DateOutcomeOutcome ReasonNumber
222023566426/04/2022Refused1
222023566426/05/2022AllowedReview1

The idea is that the data will be added on a daily basis and overtime it will be difficult to change the results of the "Number" column based on the duplicates. I was hoping to have a VBA code that I can run on a weekly or monthly basis to update the Number column.

Please assist in this matter.
 
Sort by date Sort by votes
mumps said:
The original code referred to column U instead of column T. Has your file changed? Please use the XL2BB add-in (icon in the menu) to attach an updated screenshot (not a picture) of your sheet.
Click to expand...
I updated the code when I changed a couple of columns. I would like to add that this data is in a table, but before I execute the MACRO, I always convert it to a range and remove any filters.

Please see attached updated screenshot using the X2LBB

Dummy Data.xlsx
ABCDEFGHIJKLMNOPQRSTUVWX
1Notification DatePCN No.Appeal reference Hearing TypeHearing date Decision Date Outcome Outcome Reason Direction Case Type Static/MovingContravention code Location Pack by Date Evidence submittedNoR UserNoR DateAdjudicatorPCN TypeNumberDateMonthYearWeek Ending
204/04/2022UK056896512221127412 Postal 25/03/202202/04/2022Appeal RefusedMoving 33Sachin Tendulkar RoadLW16/03/2022GBU########Up102April202203-Apr-22
304/04/2022UK056051962221141515 Postal 02/04/202202/04/2022Appeal RefusedMoving 33Shane Ware RoadTG28/03/2022KMO########Down102April202203-Apr-22
404/04/2022UK070110462221171944Postal 02/04/202202/04/2022Appeal RefusedMoving 33Curtly Ambrose RoadAW23/02/2022KMO########Left102April202203-Apr-22
504/04/2022UK073032342221153151Postal 02/04/202202/04/2022Appeal RefusedStatic12Mark Waugh RoadTG28/03/2022JBU########Left102April202203-Apr-22
607/07/2022UK070865552221181185Postal 03/04/202207/07/2022Appeal AllowedStatic40Steve Waugh RoadMU07/03/2022Up107July202210-Jul-22
707/04/2022UK035241402221115239Postal 06/04/202206/04/2022Appeal AllowedMoving 33Brian Charles Lara RoadDown106April202210-Apr-22
807/04/2022UK06942613 2221241111Postal 06/04/202206/04/2022Appeal AllowedStatic1Wasim Akram RoadVC########Down106April202210-Apr-22
907/04/2022UK07295384 2221241937 Postal 06/04/202206/04/2022Appeal AllowedStatic19Imran Khan RoadVC########Down106April202210-Apr-22
1008/04/2022 UK054867892221164238personal07/04/202207/04/2022Appeal AllowedMoving 33Waqar Younis RoadTG09/03/2022TH########Down107April202210-Apr-22
1108/04/2022UK058440842221252516personal07/04/202207/04/2022Appeal RefusedMoving 33Javed Miandad RoadPH########Down107April202210-Apr-22
1208/04/2022UK072131752221241812Postal 07/04/202207/04/2022Appeal RefusedStatic40Glen Mcgrath RoadVC########Left107April202210-Apr-22
1308/04/2022UK058915722221214517Postal 07/04/202207/04/2022Appeal RefusedMoving 32dVirat Kohli RoadGBU########Right107April202210-Apr-22
1408/04/2022UK058616952221151972Postal 07/04/202207/04/2022Appeal RefusedMoving 52Jaques Kallis RoadTG04/03/2022JBE########Up107April202210-Apr-22
1508/04/2022UK058440842221252516Postal 07/04/202207/04/2022Appeal AllowedReviewMoving 33Javed Miandad RoadMU04/03/2022Up107April202210-Apr-22
1608/04/2022UK070110462221171944personal08/04/202207/04/2022Appeal AllowedReviewStatic01Curtly Ambrose RoadMU03/03/2022Up107April202210-Apr-22
1708/04/2022UK072926152221186489personal08/04/202208/04/2022Appeal RefusedStatic12Sir Garfield Sobers RoadAW14/03/2022AJ########Up108April202210-Apr-22
1811/04/2022UK05851895222118754APostal 08/04/202209/04/2022Appeal RefusedMoving 33Harsha Bhogle RoadAW11/03/2022KMO########Down109April202210-Apr-22
1911/04/2022UK044382042221162935Postal 04/04/202209/04/2022Appeal AllowedMoving 52Richie Benaud RoadTG30/03/2022JN########Down109April202210-Apr-22
2011/04/2022UK058725342221182818Postal 09/04/202209/04/2022Appeal AllowedMoving 52Alistair Cook RoadTG01/04/2022KMO########Down109April202210-Apr-22
2111/04/2022UK044308032221162979Postal 04/04/202209/04/2022Appeal AllowedMoving 52MGraeme Swann RoadTG30/03/2022JN########Down109April202210-Apr-22
2212/04/2022UK071927892221156433Postal 29/03/202211/04/2022Appeal AllowedStatic12James Anderson RoadLW21/03/2022VC########Down111April202217-Apr-22
2312/04/2022UK059194232221139717Postal 11/04/202211/04/2022Appeal RefusedMoving 52GStuart Broad RoadAW25/02/2022JBU########Down111April202217-Apr-22
2412/05/2022JK06006073222123316APostal 26/04/202211/05/2022Appeal refused Andy Roberts RoadRight111May202215-May-22
2512/05/2022JK060275942221251638personal11/05/202211/05/2022Appeal allowed Rahul Dravid RoadRight111May202215-May-22
2612/05/2022JK060224112221251513personal11/05/202211/05/2022Appeal allowed Allan Donald RoadDown111May202215-May-22
2712/05/2022JK060104232221251615personal11/05/202211/05/2022Appeal allowed Shoaib Akhtar RoadUp111May202215-May-22
2812/05/2022JK059460402221214966personal11/05/202211/05/2022Appeal refused Brett Lee RoadUp111May202215-May-22
2901/05/2022UK058440842221252516personal11/05/202223/05/2022Appeal AllowedReviewMoving 33Javed Miandad RoadMU04/03/2022Up123May202229-May-22
3027/04/2022UK060000882221235664personal26/04/202226/05/2022Appeal AllowedReviewMoving50Babar Azam RoadLW22/04/2022JBE########Down126May202229-May-22
Data.2
Cell Formulas
RangeFormula
U2:U30U2=TEXT(F2, "DD")
V2:V30V2=IF(F2="",0,TEXT(F2, "MMMM"))
W2:W30W2=IF(F2="",0,TEXT(F2, "YYYY"))
X2:X30X2=TEXT(F2+(7-WEEKDAY(F2,2)),"dd-mmm-yy")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B2:B30Cell ValueduplicatestextNO
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Try:
VBA Code: 
Sub ChangeValue()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, lRow As Long, fVisRow As Long, lVisRow As Long, rng As Range
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("B2:B" & lRow).Value
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            If Not .exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
                Range("A1").CurrentRegion.AutoFilter 2, v(i, 1)
                Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:="Review"
                If [subtotal(103,A:A)] - 1 > 0 Then
                    fVisRow = Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
                    lVisRow = Cells(Rows.Count, "A").End(xlUp).Row
                    If fVisRow <> lVisRow Then
                        Set rng = Range("T2:T" & lVisRow - 1).SpecialCells(xlVisible)
                        rng = 0
                    End If
                End If
            End If
        Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
Sub ChangeValue()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, lRow As Long, fVisRow As Long, lVisRow As Long, rng As Range
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("B2:B" & lRow).Value
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            If Not .exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
                Range("A1").CurrentRegion.AutoFilter 2, v(i, 1)
                Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:="Review"
                If [subtotal(103,A:A)] - 1 > 0 Then
                    fVisRow = Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
                    lVisRow = Cells(Rows.Count, "A").End(xlUp).Row
                    If fVisRow <> lVisRow Then
                        Set rng = Range("T2:T" & lVisRow - 1).SpecialCells(xlVisible)
                        rng = 0
                    End If
                End If
            End If
        Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you for your response. This does not change any of the values in my dataset. I tried this code on the dummy data I pasted earlier as well and it only changes one row whereas the last code correctly changed all three rows.
 
Upvote 0
Do you still want column H to equal "Review" as a criterium?
 
Upvote 0
Try:
VBA Code: 
Sub ChangeValue()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, lRow As Long, fVisRow As Long, lVisRow As Long, rng As Range
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("B2:B" & lRow).Value
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            If Not .exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
                Range("A1").CurrentRegion.AutoFilter 2, v(i, 1)
                If [subtotal(103,A:A)] - 1 > 0 Then
                    fVisRow = Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
                    lVisRow = Cells(Rows.Count, "A").End(xlUp).Row
                    If fVisRow <> lVisRow Then
                        Set rng = Range("T2:T" & lVisRow - 1).SpecialCells(xlVisible)
                        rng = 0
                    End If
                End If
            End If
        Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps - You are a superstar. This works on my dataset without any errors. Thank you so much.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
VBA to copy a template from one sheet to another based on dropdown
2
Replies
10
Views
620
altizerc2196
A
S
  • Solved
Way to move values based on another cell around like chess pieces
Replies
4
Views
270
myall_blues
myall_blues
B
  • Question
link a VBA checkbox to a Cell to change value
Replies
6
Views
211
NoSparks
N
O
  • Solved
VBA Code to Find Duplicate Values in a Range and Add a Number at the End
2
Replies
12
Views
455
OilEconomist
O
C
  • Solved
VBA Check for duplicate value and change if duplicate.
Replies
7
Views
417
Alex Blakenburg
A

Forum statistics

Threads
1,221,851
Messages
6,162,429
Members
451,765
Latest member
craigvan888

Share this page

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