Matching text across two sheets, and if no match, then delete range on Sheet 1

[pikkuveli]

Hi everyone, hoping someone can help

Here is my dilemma. I have two sheets with several columns of data.

I want to search a range on Sheet 2 for some of the column names on Sheet 1, and if they are not found, then delete those columns (actually the range from column header to the bottom) on Sheet 1

So let´s say

Sheet 1 A B C Sheet 2 A B
zebra taxi mountain zebra mountain
2 6 14 2 14
8 4 9 8 9


So I want to search A1:C1 on Sheet 2 for zebra, taxi, mountain, and because it doesn´t find taxi in that range, i want to delete the range taxi and below

Thanks very much for any help

 

[pikkuveli]

Formatting messed up in the initial post, because I cannot edit I am adding screenshot of what I mean.

 

[mumps]

Try:

Sub DeleteRange()
    Application.ScreenUpdating = False
    Dim x As Long, lCol As Long, WS1 As Worksheet, WS2 As Worksheet, fnd As Range
    Set WS1 = Sheets("Sheet1")
    Set WS2 = Sheets("Sheet2")
    lCol = WS1.Cells(1, Columns.Count).End(xlToLeft).Column
    For x = 1 To lCol
        With WS1
            Set fnd = WS2.Rows(1).Find(.Cells(1, x).Value, LookIn:=xlValues, lookat:=xlWhole)
            If fnd Is Nothing Then
                .Cells(1, x).EntireColumn.ClearContents
            End If
        End With
    Next x
    Application.ScreenUpdating = True
End Sub

 

[RobP]

Hi,

I like @mumps code more than mine... He erases the info in the entire column so its all blank.

I give you the option below to delete the entire column from the face of the earth , or erase the data below the header (leaving the header intact).

same but different ... depending on which line of code you select to use below.

Sub check_cols()
Application.ScreenUpdating = False
Dim checkname As String
Dim y As Long

lCol1 = Sheets("Sheet1").Cells(1, Sheets("Sheet1").Columns.Count).End(xlToLeft).Column 'l = row number to search in for last column.
lCol2 = Sheets("Sheet2").Cells(1, Sheets("Sheet2").Columns.Count).End(xlToLeft).Column

For y = lCol1 To 1 Step -1

    checkname = Sheets("Sheet1").Cells(1, y).Value
    found = False
   
    For y2 = 1 To lCol2
        If checkname = Sheets("Sheet2").Cells(1, y2).Value Then
            found = True
            Exit For
        End If
    Next y2
   
    If Not found Then
      
        lastrow = Sheets("Sheet1").Cells(Rows.Count, y).End(xlUp).Row
        ' ***** select one of the following 2 lines of code only, depending on what you want to do by removing/adding the ' before it. ******
       
        'Sheets("Sheet1").Range(Cells(2, y), Cells(lastrow, y)).EntireColumn.Delete ' this removes the entire column from Sheet 1 (including header name).
        Sheets("Sheet1").Range(Cells(2, y), Cells(lastrow, y)).Clear 'this will erase data only BELOW the column header, but leave the header there (if you prefer)
       
    End If
   
Next y
'Application.ScreenUpdating = True
End Sub

 

[mumps]

If the column is to be deleted, then change "ClearContents" to "Delete".

 

[pikkuveli]

Hi both, THANK YOU MASSIVELY

Both/all solutions work brilliantly.

I could only mark one as a solution so I gave it to the first one.

 

[mumps]

Glad we could help.