VBA Code to find corresponding cell in worksheet & clear the cells below

[Excelquestion35]

Hi all,

Currently I am looking for a way to find a certain that is a header (first row, one of the columns).

In the code below, the following process is done:

• Filter a worksheet by a Customer (As a String)
• Copy only column C of the filtered cells (list of managers)
• Paste these cells in A2 in the tgt Workbook.

This code is almost doing the job that I want it to do. However I have two things that I struggle to add:

1. How do I find the corresponding customer in the tgt Workbook, thus replace value A2 by the Customer As a string?
   To give you an idea, in the tgt Workbook every first cell of a column contains one of the customers (A1, B1 etc.) . Below this first cell is the list of managers that I want replaced.
   My code should replace the list of managers by the managers of the corresponding customer.
2. The current code does not keep in mind the length of the list of mangers. E.g. The list of managers that I copy can be shorter than that is currently the case and thus not removes any obsolete manager.
   How do I make sure that before I copy, I remove the list of current managers (e.g. G2:last row) for this specific Customer (As a String) where I am currently replacing the managers of?

Sub Replacetext()
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range
    Dim copyRange As Range
    Dim lastRow As Long
    Dim customer As String
    
    Set src = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLMs")
    Set tgt = Workbooks("Kronos Centraal Formulier v3.2 - Template (zonder check) - RPA versie.xlsm").Sheets("Supervisor (leidinggevende)")
    customer = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLM-change").Range("C17")
    

    src.AutoFilterMode = False
    lastRow = src.Range("C" & src.Rows.Count).End(xlUp).Row

    Set filterRange = src.Range("B3:P" & lastRow)
    Set copyRange = src.Range("C4:C" & lastRow)

   filterRange.AutoFilter field:=1, Criteria1:=customer
  
    copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A2")

End Sub

Your help is much appreciated!

 

[Fluff]

How about

Sub Replacetext()
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range, PasteRange As Range
    Dim copyRange As Range
    Dim lastRow As Long
    Dim customer As String
    
    Set src = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLMs")
    Set tgt = Workbooks("Kronos Centraal Formulier v3.2 - Template (zonder check) - RPA versie.xlsm").Sheets("Supervisor (leidinggevende)")
    customer = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLM-change").Range("C17")
    Set PasteRange = tgt.Range("1:1").Find(customer, , , xlWhole, , , flase, , False)

    If PasteRange Is Nothing Then
         MsgBox customer & " not found"
         Exit Sub
    End If
    PasteRange.Offset(1).Resize(1000).ClearContents
    
    src.AutoFilterMode = False
    lastRow = src.Range("C" & src.Rows.Count).End(xlUp).Row

    Set filterRange = src.Range("B3:P" & lastRow)
    Set copyRange = src.Range("C4:C" & lastRow)

   filterRange.AutoFilter field:=1, Criteria1:=customer
  
    copyRange.SpecialCells(xlCellTypeVisible).Copy PasteRange.Offset(1)

End Sub

 

[Excelquestion35]

Fantastic, this was indeed what I was looking for! One question regarding the loop. Would it also be possible to, instead of finding the exact match between 'customer' and the customer in the tgt Workbook, look for a value that contains 'customer'?

 

[Fluff]

Just change xlWhole to xlPart.

 

[Excelquestion35]

Thanks again, Fluff!

 

[Fluff]

My pleasure.