VBA Search for match, if found, clear content in match rows

[Engalpengal]

Hello.
I am working on a project, where i want to track products in our factory.
The process start by me loading orders in a workbook called "Ordre"
It is a list of products with information spread out in rows C:P - See Pic 1
When a process is done, a date is filled in Q:AF depending on witch prosess that is completed (VBA program). These columns is hidden. - See Pic 2
In column AH:AV I have excel formulas that shows If the product should go throug the process (No=x, Yes=Process desc ex. PR), or if the process is done(Done=V). - See Pic 3

Ex of formulas: =IF(C22<1;"";IF(AE22>1;"V";XLOOKUP(F22;BOM!A:A;BOM!AC:AC;"x";0)))

With a click of a button all Product lines With "V" in column AV (the last process) is copied into av workbook called History.

Now i need to cleare (ClearContents) the same lines that was copied into History, from workbook "Ordre".

Under follows my attempt.
The program does not give me an Error, but nothing happens either, other than the workbook is thinking.
So what am i doing wrong?

Sub Fjern_ferdig()

unprotect
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim wbo As Workbook
Dim wsSrc As Worksheet
Dim i As Integer

Set wbo = ThisWorkbook
Set wsSrc = wbo.Worksheets("Ordre") '______________________________________________________Sheet for search area
Set srcKey = wsSrc.Range("AV8") '___________________________________________________________Search key (The cell contains the letter V)

finalrow = wsSrc.Range("AV1000").End(xlUp).Row '__________________________________________Setting search area (These cells contains excel formulas)

For i = 48 To finalrow
    If Cells(i, 48) = srcKey Then
        wsSrc.Range(Cells(i, 3), Cells(i, 32)).ClearContents
    End If
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
protect
ActiveWorkbook.Save

End Sub

Sub unprotect()
ActiveSheet.unprotect "1234"

End Sub

Sub protect()
ActiveSheet.protect "1234"

End Sub

 

[Engalpengal]

Hello again.
I have now made some small cosmetic adjustments, but the program itself is unchanged.
And now the macro no longer work.

Sub Fjern_ferdig()

unprotect
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim wbo As Workbook
Dim wsSrc As Worksheet
Dim i As Integer

Set wbo = ThisWorkbook
Set wsSrc = wbo.Worksheets("Ordre") '______________________________________________Sheet for search area
Set srcKey = wsSrc.Range("AG12") '__________________________________________________Search key (The cell contains the letter V)

finalrow = wsSrc.Range("AG1000").End(xlUp).Row '__________________________________Setting search area, last row

With wsSrc
    For i = 13 To finalrow '____________________________________________________________Start row to final row
        If Cells(i, 13) = srcKey Then '____________________________________________________Start from row 13, and match Key
            .Range(Cells(i, 3), Cells(i, 32)).ClearContents '________________________________If match clear row (Row start to end, col 3-13)
        End If
    Next i
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
protect
ActiveWorkbook.Save

End Sub

 

[kevin9999]

Hello again.
I have now made some small cosmetic adjustments, but the program itself is unchanged.
And now the macro no longer work.

Sub Fjern_ferdig()

unprotect
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim wbo As Workbook
Dim wsSrc As Worksheet
Dim i As Integer

Set wbo = ThisWorkbook
Set wsSrc = wbo.Worksheets("Ordre") '______________________________________________Sheet for search area
Set srcKey = wsSrc.Range("AG12") '__________________________________________________Search key (The cell contains the letter V)

finalrow = wsSrc.Range("AG1000").End(xlUp).Row '__________________________________Setting search area, last row

With wsSrc
    For i = 13 To finalrow '____________________________________________________________Start row to final row
        If Cells(i, 13) = srcKey Then '____________________________________________________Start from row 13, and match Key
            .Range(Cells(i, 3), Cells(i, 32)).ClearContents '________________________________If match clear row (Row start to end, col 3-13)
        End If
    Next i
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
protect
ActiveWorkbook.Save

End Sub

You're now starting from row 13, and checking column M (Cells(I,13) = "M13". Is column M now the column of interest? Tip: Cells(Row,Column).

 

[Engalpengal]

Thanks Kevin. I suspected that I mixed up column and row....

 

[kevin9999]

This means row number right?

This means the row number IF you put the "i" as the first argument in Cells e.g. Cells(i,Column_number). It would be the column if it was the second argument, e.g. Cells(Row_number,i).

 

[Engalpengal]

Thanks to you Kevin i finally have a working macro.

The solution as promised:

Sub Remove_ord()

unprotect
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim wbo As Workbook
Dim wsSrc As Worksheet
Dim i As Integer

Set wbo = ThisWorkbook
Set wsSrc = wbo.Worksheets("Ordre") '________________________________________________________Sheet for search area
Set srcKey = wsSrc.Range("AG12") '___________________________________________________________Search key (The cell contains the letter V)

finalrow = wsSrc.Range("AG1000").End(xlUp).Row '_____________________________________________Setting search area, last row

With wsSrc
    For i = 13 To finalrow '_________________________________________________________________Start from row....
        If Cells(i, 33) = srcKey Then '______________________________________________________Match Key to column 33
            .Range(Cells(i, 3), Cells(i, 32)).ClearContents '________________________________If match clear row (Row start to end, col 3-32)
        End If
    Next i
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
protect
ActiveWorkbook.Save

End Sub

 

[Engalpengal]

BHW
Can i use the same macro with some modifications to copy match to other workbook?

I tride, but failed

Sub Copy_Hist()

unprotect
unprotectH
Workbooks.Open "C:\Angel\Produksjonsstyring\ProdSpor\Hist.xlsm"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim wbo As Workbook, wbh As Workbook
Dim wsSrc As Worksheet, wsHi As Worksheet
Dim i As Integer

Set wbo = ThisWorkbook
Set wsSrc = wbo.Worksheets("Ordre") '________________________________________________________Sheet for search area
Set srcKey = wsSrc.Range("AG12") '___________________________________________________________Search key (The cell contains the nuber 1)

Set wbh = Workbooks("Hist.xlsm")
Set wsHi = wbh.Worksheets("Hist")
Set cDest = wsHi.Range("A" & Rows.Count).End(xlUp).Offset(1) '_______________________________Range for Paste destination

finalrow = wsSrc.Range("AG1000").End(xlUp).Row '_____________________________________________Setting search area, last row

With wsSrc
    For i = 13 To finalrow '_________________________________________________________________Start from row 13....
        If Cells(i, 33) = srcKey Then '______________________________________________________Match Key to column 33
            .Range(Cells(i, 3), Cells(i, 32)).Copy cDest
        End If
    Next i
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
protect
protectH
ActiveWorkbook.Save
Workbooks("Hist.xlsm").Close SaveChanges:=True

End Sub

 

[kevin9999]

I wouldn't use this method at all. I would use an Autofilter and copy the entire range en masse. To provide the code to do that, please post copies of both your existing worksheets "Ordre" and "Hist" using the XL2BB add in - not images - or alternatively, share your file via Google Drive, Dropbox or similar file sharing platform.

 

[Engalpengal]

*

 

[Engalpengal]

*

 

[Engalpengal]

Sorry about this. First time trying.
You where thinking of me pasting a mini sheet in here correct?