Checking for multiple criteria (delete old values if changed, delete new values if no change)

Question

At first, I tried to write down multiple If & VLOOKUP formulas and insert them via VBA. This caused my computer to crash. I have to check for serval conditions/criteria. Here is the example table:

The grayed values are the ones I want to delete. Wrong dates in the example (should be weekly, not daily).

Every friday, I want to insert a new column between C & D with the todays date (you can find the macro further down. It works). Then the macro should check for the inserted values. If the macro inserts a new value that wasn't there before, it should take it and delete everything else in the row of the columns A to C in the example (this is variable because I'll insert a new column every week - it should check the columns A:[X] LastCol Offset -2). If the macro puts out the same value a week later, it should only keep the oldest one. This will let us now, when the value got entered. Last step: in column D insert the value we have kept - this means the only value in the range A:[X] LastCol Offset -2. If the output is nothing (#N/A) in all cells, then insert "Other" in column D (LastCol Offset -1)

At the moment the columns have an INDEX(MATCH(()) formula. This formula will get copied into the new column and the column that got copied will special pasted with values only (the last step isn't in the code, but that's not the problem).

Sub insertColumn()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Copies the third last column and inserts it between the column [last date] and Overall'
With Sheets("getDATA")
    Lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Columns(Lastcol - 2).Copy
    .Columns(Lastcol - 1).Insert Shift:=xlToRight
End With

With Sheets("getDATA")
    .Range("G7").End(xlToRight).Offset(0, -2).Value = Date
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

TL;DR: If Output is same like the weekS before, only keep the oldest value. If the value is different from the weekS before, only keep the new value. If nothing got entered, write "Other" in column D in this example (LastCol Offset -1). If it has a value, insert it in column D

Public Sub TestMe()

Dim myRow           As Range
Dim myCell          As Range
Dim inputRange      As Range
Dim previousCell    As Range
Dim flagValue       As Boolean
Dim lastCell        As Range
Dim LastRow         As Long
Dim LastCol         As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("getDATA")
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Set inputRange = Worksheets(1).Range(Cells(8, 13).Address(), Cells(LastRow, LastCol - 2).Address())
For Each myRow In inputRange.Rows
    Set previousCell = Nothing
    flagValue = False
    For Each myCell In myRow.Cells
        If Len(myCell) Then flagValue = True
        If Not previousCell Is Nothing Then
            If previousCell <> myCell Then
                previousCell.clear
                Set previousCell = myCell
            Else
                myCell.clear
            End If
        Else
            Set previousCell = myCell
        End If
        Set lastCell = myCell
    Next myCell

    If Not flagValue Then
        lastCell.Offset(0, 1) = "Other"
    Else
        lastCell.Offset(0, 1) = previousCell
    End If
Next myRow

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

You need two nested loops - one through rows and one through cells. The rest is a bit of fixing the cells, remembering values and puting flags. Instead of clearing the cell, I have colored it in red.

To clear it, change the myCell.Font.Color = vbRed to myCell.clear.

Public Sub TestMe()

    Dim myRow           As Range
    Dim myCell          As Range
    Dim inputRange      As Range
    Dim previousCell    As Range
    Dim flagValue       As Boolean
    Dim lastCell        As Range

    Set inputRange = Worksheets(1).Range("A1:C4")
    inputRange.Font.Color = vbBlack
    For Each myRow In inputRange.Rows
        Set previousCell = Nothing
        flagValue = False
        For Each myCell In myRow.Cells
            If Len(myCell) Then flagValue = True
            If Not previousCell Is Nothing Then
                If previousCell <> myCell Then
                    previousCell.Clear
                    Set previousCell = myCell
                Else
                    myCell.Font.Color = vbRed 'or myCell.clear to clear the value
                End If
            Else
                Set previousCell = myCell
            End If
            Set lastCell = myCell
        Next myCell    
        If Not flagValue Then
            lastCell.Offset(0, 1) = "Other"
        Else
            lastCell.Offset(0, 1) = previousCell
        End If
    Next myRow
End Sub

Input:

After the code:

Concerning identifying the inputRange. It really depends how your range looks like and from which row and column does it start. In the general case, if it starts from A1 to the last used one, the range can be setted like this:

With Worksheets(1)
    Set inputRange = .Range(.Cells(1, 1), .Cells(LastUsedRow, LastUsedColumn))
End With

LastUsedColumn and LastUsedRow are from here. If you want to eliminate two left columns, you can simply do it like this:

With Worksheets(1)
    Set inputRange = .Range(.Cells(1, 1), .Cells(LastUsedRow, LastUsedColumn-2))
End With