Excel vba to Find Cell and Delete Rows

[miniminh02]

I have a value in "D8" and another value in "G8".

I'd like to have a macro that would find the value in "D8" in column B starting with "B13". Once it finds the value I'd like it to delete all rows above that value up to row "B13".

Then I'd like it to find the value in "G8" in column B starting with "B13" and delete all the rows below that value down to "B100".

Is that possible? I'm sorry, I am completely lost .

Thanks so much for your help .

Minh

...or instead of having values in D8 and G8, a pop up that asks for values to look for would be nice too.

 

[AlphaFrog]

Sub Delete_Above_and_Below()

    Dim Found As Range
    
    Application.ScreenUpdating = False
    
    If Range("D8").Value <> "" Then
        Set Found = Range("B13:B100").Find( _
                          What:=Range("D8").Value, _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, _
                          MatchCase:=False)
        If Not Found Is Nothing Then Range("B13", Found).Delete Shift:=xlShiftUp
    End If
    
    If Range("G8").Value <> "" Then
        Set Found = Range("B13:B100").Find(What:=Range("D8").Value)
        If Not Found Is Nothing Then Range(Found, "B100").Delete Shift:=xlShiftUp
    End If
        
    Application.ScreenUpdating = True
    
End Sub

 

[AlphaFrog]

This deletes the rows and not just the cells in column B and corrects a typo in the previous code.

Sub Delete_Above_and_Below()

    Dim Found As Range
    
    Application.ScreenUpdating = False
    
    If Range("D8").Value <> "" Then
        Set Found = Range("B13:B100").Find( _
                          What:=Range("D8").Value, _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, _
                          MatchCase:=False)
        If Not Found Is Nothing Then Range("B13", Found)[COLOR="Red"].EntireRow[/COLOR].Delete
    End If
    
    If Range("G8").Value <> "" Then
        Set Found = Range("B13:B100").Find(What:=Range("[COLOR="Blue"]G8[/COLOR]").Value)
        If Not Found Is Nothing Then Range(Found, "B100")[COLOR="Red"].EntireRow[/COLOR].Delete
    End If
        
    Application.ScreenUpdating = True
    
End Sub

 

[miniminh02]

Thank you for your help!! It worked!!

Now, is there a way to make it work with dates since the format is different?

 

[AlphaFrog]

It should work with dates if the date values are serial dates and not text dates.

Convert dates stored as text to dates

Dates And Times In Excel

Convert Dates with Replace All

 

[miniminh02]

Thank you so much! That was the exactly the problem, I had the dates stored as text. You're wonderful!

Much thanks,
Minh

 

[AlphaFrog]

You're welcome.