Delete entire column if specific cells are unchanged

[bdkrame]

I've got a large number of single column data entries that I'm trying to cull down to useful information. Currently, a test generates a single entry that records 13 rows of information. If no settings have been changed, the only difference between any two columns is the date and time. I'd like to delete the columns that have no difference from the previous column except for date and time.

I'm at a loss for starting points. All the solutions I can think of and that Google can provide end up deleting all but the most recent entry. Can anyone provide assistance?

 

[ExcelGuyDude]

Please look over your question again, and make sure you're using the term "Columns" and "Rows" correctly. Also, showing a screenshot, or inserting a table into this forum makes answering these kinds of questions loads easier.

 

[bdkrame]

Sorry if I'm not being clear. Here is what I've got so far. It seems to be doing what I want it to, but I'm open to critique.

Sub Clean_Data()

    Dim ws As Worksheet
    Dim i As Long
    Dim delRange As Range
    Dim lastColumn As Long
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    lastColumn = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    With ws
        'Loop through relevant columns
        For i = 2 To lastColumn
            'Check if the value is equal to previous column
            If UCase(Trim(.Cells(12, i).Value)) = .Cells(12, i - 1).Value And UCase(Trim(.Cells(14, i).Value)) = .Cells(14, i - 1).Value And UCase(Trim(.Cells(16, i).Value)) = .Cells(16, i - 1).Value And UCase(Trim(.Cells(18, i).Value)) = .Cells(18, i - 1).Value And UCase(Trim(.Cells(20, i).Value)) = .Cells(20, i - 1).Value And UCase(Trim(.Cells(22, i).Value)) = .Cells(22, i - 1).Value And UCase(Trim(.Cells(24, i).Value)) = .Cells(24, i - 1).Value And UCase(Trim(.Cells(26, i).Value)) = .Cells(26, i - 1).Value Then
                'Store the Range to delete later
                If delRange Is Nothing Then
                    Set delRange = .Columns(i)
                Else
                    Set delRange = Union(delRange, .Columns(i))
                End If
            End If
        Next i
    End With

    'Delete the relevant columns
    If Not delRange Is Nothing Then delRange.Delete
End Sub

Each entry is 1 column and 26 rows (after formatting from the 13 original rows). There are 8 different criteria that the code checks against the previous entry. If it finds that all 8 are the same values, it adds the column to a range that gets deleted after the loop is completed. If any one of the values are different it passes over the column.

How does it look?


EDIT:
I forgot to mention that the workbook pulls each entry and puts it into the next empty column, so I start off with a sheet that is 13 rows and hundreds of columns.

 

[ExcelGuyDude]

It looks pretty good to me... My preferred method to delete multiple columns/rows is to create a range and delete it at the end. Good job on using that method!

The only thing that looks sloppy is the long IF statement. I would have it do a loop through each of those cells instead. I don't think you need to include the "UCase(Trim(" either. If you need to use it, then use it on both sides of the formula... (e.g. UCase(Trim(.Cells(12, i).Value)) = UCase(Trim(.Cells(12, i - 1).Value)).

This is how I'd do it with the loop through the cells:

Sub Clean_Data()

    Dim ws As Worksheet
    Dim i As Long, j As Integer
    Dim delRange As Range
    Dim lastColumn As Long
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    lastColumn = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    With ws
        For i = 2 To lastColumn
            For j = 1 To 8
                If Cells(10 + (2 * j), i).Value <> Cells(10 + (2 * j), i - 1).Value Then
                    GoTo DifferentValue
                End If
            Next j

            If delRange Is Nothing Then
                Set delRange = .Columns(i)
            Else
                Set delRange = Union(delRange, .Columns(i))
            End If
DifferentValue:
        Next i
    End With
    If Not delRange Is Nothing Then delRange.Delete
End Sub