I give up... VBA help needed

[Mr_Ragweed]

Hi,
I'm trying very hard to solve my own code issues but hours have turned to days on what should probably only be a few lines of script.
My Code is below:

Sub Edit_Dropdown_Lists()
'Hopefully this will be a worksheet event that when data is populated to the ProductFormulas_
'sheet this macro will delete the matching product from the ProdXDept sheet
Dim FinalRow As Long
Dim FinalCol As Long
Dim rngFnd As Range
Dim LRow As Long
FinalRow = ActiveSheet.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = ActiveSheet.Cells(1, Application.Columns.Count).End(xlToLeft).Column

 If Sheets("ProductFormulas").Select = True Then
    Cells(FinalRow, 1).Select
    
    With Sheets("PrdXDept")
        LRow = Cells(Rows.Count, "A").End(xlUp).Row
        Set rngFnd = Sheets("PrdXDept").Range("A2:J2" & FinalRow)
                If rngFnd.Value = Sheets("ProductFormulas").Range(FinalRow, 1).Value Then
               [COLOR=#FF0000] rngFnd.Select[/COLOR]
                Selection.Delete Shift:=xlUp
                    ElseIf rngFnd.Value <> Sheets("ProductFormulas").Range(FinalRow, 1).Value Then
                    Exit Sub
                    
                End If
        End With
 End If
 
End Sub

The part in red is the obvious error (or at least 1 of them).

The goal of this macro is to find the last cell in Column A on 1 worksheet, Find its match somewhere on a second worksheet, Delete the match and shift cells up so there are no blanks left behind.

I really need help. I've read many posts and tried to adapt them but apparently i'm not smart enough. Most posts seem to be related to using a formula instead of VBA.

Thanks!

 

[wwbwb]

Shouldn't this be:

 Set rngFnd = Sheets("PrdXDept").Range("A2:J" & FinalRow)

instead of:

 Set rngFnd = Sheets("PrdXDept").Range("A2:J2" & FinalRow)

 

[NdNoviceHlp]

It seems your NewData variable should actually be a string. Untested code. HTH. Dave

Sub Edit_Dropdown_Lists()
'Hopefully this will be a worksheet event that when data is populated to the ProductFormulas_
'sheet this macro will delete the matching product from the ProdXDept sheet
Dim FinalRow As Long
Dim FinalRow2 As Long
Dim C As Range
'Dim FinalCol As Long
Dim rngFnd As Range
Dim NewData As Double

With Sheets("ProductFormulas")
FinalRow = .Range("A" & .Rows.Count).End(xlUp).Row
'FinalCol = .Cells(1, Application.Columns.Count).End(xlToLeft).Column
End With
NewData =  Sheets("ProductFormulas").Cells(FinalRow, 1)

With Sheets("PrdXDept")
FinalRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
End With
    
Set rngFnd = Sheets("PrdXDept").Range("A2:J" & FinalRow2)
For Each C In rngFnd
If C.Value = NewData Then
C.Delete Shift:=xlUp
End If
Next C
End Sub

 

[Mr_Ragweed]

Thank you wwbwb for catching my typo in the range and thank you NoviceHelp for pointing out mt "NewData" Issue.

I trieed the untested code and get a 'type mismatch on this line:

NewData =  Sheets("ProductFormulas").Cells(FinalRow, 1)

any ideas?

 

[Mr_Ragweed]

IT WORKS!!!!!!! THANK YOU THANK YOU THANK YOU!!!

Sub Edit_Dropdown_Lists()
'Hopefully this will be a worksheet event that when data is populated to the ProductFormulas_
'sheet this macro will delete the matching product from the ProdXDept sheet
Dim FinalRow As Long
Dim FinalRow2 As Long
Dim C As Range
'Dim FinalCol As Long
Dim rngFnd As Range
Dim NewData As String

With Sheets("ProductFormulas")
FinalRow = .Range("A" & .Rows.Count).End(xlUp).Row
'FinalCol = ActiveSheet.Cells(1, Application.Columns.Count).End(xlToLeft).Column
End With
NewData = Sheets("ProductFormulas").Cells(FinalRow, 1)
With Sheets("PrdXDept")
FinalRow2 = .Range("A" & Rows.Count).End(xlUp).Row
End With
Set rngFnd = Sheets("PrdXDept").Range("A2:J" & FinalRow2)
        
    For Each C In rngFnd
        If C.Value = NewData Then
        C.Delete Shift:=xlUp
            
        End If
    Next C
    
 
End Sub

The suggested code had "Dim NewData As Double". I changed Double to String and it works!!

I'm so excited i'm numb to all who helped

 

[NdNoviceHlp]

You are Welcome and thank you for posting your outcome. If you are only deleting 1 match, then the following would be quicker. Dave

For Each C In rngFnd
If C.Value = NewData Then
C.Delete Shift:=xlUp
Exit Sub
End If
Next C