Update Logic - Clear Contents & Cell Value Formatting

Hello Friends..

Can anyone please assist me in below Point 1 & pont 2..

I tried everything but not getting a correct code to run..

Point 1) Below is the code which helps to clear values from Cells of columns AA, AB & AC if Cells of Column Vis Null or empty

Sub POINT1()


Dim i As Long

With ThisWorkbook.Worksheets("RESULTS")

 For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        If .Range("V" & i).Value <> vbNullString Or .Range("V" & i).Value = "" Then
             If InStr(1, .Range("V" & i).Value, "RUM", vbTextCompare) = 0 Then
                .Range("AA" & i).ClearContents
                .Range("AB" & i).ClearContents
                .Range("AC" & i).ClearContents
            End If
        End If
    Next

End With

End Sub

The problem here is that i am data of more than 50,000 & the above code takes around 30-45 minutes to execute or sometime crash or sometime no response


Point 2) This below code copies the cell data from column 25 & paste it in column 26 if the cell is blank in column 26.. but after copying it is converting the date as date (
attached is the file for reference..
The data in Column Z cells marked in yellow shows data as year 2017.. but according to Column V its 2016 year.. example (RUM122316-070725-49)
How can we change or update the code .. please suggest

Sub POINT2()

Dim NR As Long
With ThisWorkbook.Worksheets("RESULTS")
ActiveSheet.Range("Y:Y").Select
    With Selection
    .NumberFormat = "0"
    End With

    
    ActiveSheet.Range("Y2").Select
    NR = .Range("A" & .Rows.Count).End(xlUp).Row
    Range("Y2:Y" & NR).Formula = "=CONCATENATE(MID(V2,4,2),""/"",MID(V2,6,2))"


Dim i As Long
Dim LTR As Long

    With ThisWorkbook.Worksheets("RESULTS")
LTR = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To LTR
        If .Range("Z" & i).Value = vbNullString Or .Range("Z" & i).Value = "" Then
        Cells(i, 26).Value = Cells(i, 25).Value
        Cells(i, 26).Font.ColorIndex = 5
       
        End If
    Next
        Range("Z2:Z" & NR).Value = Range("Z2:Z" & NR).Value
    End With
    End With

End Sub

Hello Experts please suggest/ assist a better code for Poiint1 & Point 2

Hello Parth007,

The code shown for Point 1 is 3 times faster on the sample workbook and will be much faster on a larger data set.

As for Point 2, the abbreviated date method displaying the the month and day less the year, mm/dd, only works with the current year. You cannot use this format with dates that are not the current year. You will have to display the date in mm/dd/yy format.

Point 1 Macro Code

Sub POINT_1()

    Dim Cell As Range
    Dim i    As Long
    
        With ThisWorkbook.Worksheets("RESULTS")
            For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                Set Cell = .Cells(i, "V")
                If Len(Cell) > 0 Then
                    If InStr(1, Cell, "RUM", vbTextCompare) > 0 Then
                        Cell.Offset(0, 5).Resize(1, 3).Value = Empty
                    End If
                End If
            Next i
        End With
    
End Sub

Hello Parth007,

The code shown for Point 1 is 3 times faster on the sample workbook and will be much faster on a larger data set.

As for Point 2, the abbreviated date method displaying the the month and day less the year, mm/dd, only works with the current year. You cannot use this format with dates that are not the current year. You will have to display the date in mm/dd/yy format.

Point 1 Macro Code

Sub POINT_1()

    Dim Cell As Range
    Dim i    As Long
    
        With ThisWorkbook.Worksheets("RESULTS")
            For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                Set Cell = .Cells(i, "V")
                If Len(Cell) > 0 Then
                    If InStr(1, Cell, "RUM", vbTextCompare) > 0 Then
                        Cell.Offset(0, 5).Resize(1, 3).Value = Empty
                    End If
                End If
            Next i
        End With
    
End Sub

hi Ross,

The Code for Point 1 WORKED... I HAVE CHANGED THE '<' & '>' to '='

Sub POINT_1()

    Dim Cell As Range
    Dim i    As Long
    
        With ThisWorkbook.Worksheets("RESULTS")
            For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                Set Cell = .Cells(i, "V")
                If Len(Cell) = 0 Then
                    If InStr(1, Cell, "RUM", vbTextCompare) = 0 Then
                        Cell.Offset(0, 5).Resize(1, 3).Value = Empty
                    End If
                End If
            Next i
        End With
    
End Sub

Please assist me if the changes I have done is correct