Copy and paste if cell contains specific text

[Koszykowa]

Hello

I have to create a macro that help coping and pasting the data from on Worksheet to another if cells contains specific data.

In Sheet 1 I have data in column B - list of managers and locales where they are, e.g.:

B
Jack da_DK
Ruby el_GR
John cs_CZ
William no_NO

I would like to ask you if you could write a macro that will check if the column B, cell by cells, contains one of the name of locale. If contains, only the name of the locale should be copied to the same row in the next Worksheet, but to column C. There is no option that the column B will not contains the name of the locale.

Full list of locales is below:
da_DK
el_GR
cs_CZ
no_NO
fi_FI
hu_HU

Thanks for your help, I appreciate it!

[Artik]

Cześć Koszykowa​, jaki ten świat mały

eg

Sub AAA()
  Dim strLoc As String
  Dim varLoc As Variant
  Dim rngCell As Range
  Dim rngData As Range
  Dim wks1 As Worksheet
  Dim wks2 As Worksheet
  
   strLoc = "|da_DK|el_GR|cs_CZ|no_NO|fi_FI|hu_HU|"
  
  Set wks1 = Worksheets("Sheet1")
  Set wks2 = Worksheets("Sheet2")
  
  Set rngData = wks1.Range("A1").CurrentRegion.Columns(2).Cells
  
  With rngData
    Set rngData = .Offset(1).Resize(.Rows.Count - 1)
  End With
  
  For Each rngCell In rngData
    varLoc = Split(rngCell.Value, " ")
    
    varLoc = varLoc(UBound(varLoc))
    
    If strLoc Like "*|" & varLoc & "|*" Then
      wks2.Cells(rngCell.Row, "C").Value = varLoc
    End If
  Next rngCell
  
End Sub

Artik

[dangelor]

Possibly... assumes locales in col A

Sub Copy_and_paste_if_cell_contains_text()
    Dim i As Long, j As Long
    Dim lRowB As Long, lRowA As Long
    
    With Sheets(1)
        lRowB = .Cells(.Rows.Count, 2).End(xlUp).Row
        lRowA = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 1 To lRowB
            For j = 1 To lRowA
                If InStr(.Cells(i, 2), .Cells(j, 1)) Then Sheets(2).Cells(i, 3) = .Cells(i, 2)
            Next j
        Next i
    End With
End Sub

[Koszykowa]

Hello dangelor,

Thank you for your code. Unfortunately it is not working as I expected, but thank you for your time and effort. It is highly appreciated that you tried to help me.

Take care :-)

[Koszykowa]

Hello Artik,

I would like to say big thank you for your help and effort! That's very kind!

[Artik]

(from private message)

Could you make so that the place was captured, even if the record is not only:

Paul da_DK

but also

Paul da_DK Kopenhagen
Paul da_DK Kopenhagen Europe
da_DK Paul

In short, when the value is also in the middle and at the beginning.

Sometimes a slight change in the input conditions causes the whole solution to be turned upside down. That's why I recommend always rethinking the question and giving a representative attachment.
In this case, fortunately, the change is small.

Sub BBB()
    Dim regex       As Object
    Dim varLoc      As Variant
    Dim rngCell     As Range
    Dim rngData     As Range
    Dim wks1        As Worksheet
    Dim wks2        As Worksheet
    Dim i           As Long


    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\b(da_DK|el_GR|cs_CZ|no_NO|fi_FI|hu_HU)\b"


    Set wks1 = Worksheets("Sheet1")
    Set wks2 = Worksheets("Sheet2")

    Set rngData = wks1.Range("A1").CurrentRegion.Columns(2).Cells

    With rngData
        Set rngData = .Offset(1).Resize(.Rows.Count - 1)
    End With


    For Each rngCell In rngData

        If regex.Test(rngCell.Value) Then
            varLoc = Split(rngCell.Value, " ")

            For i = 0 To UBound(varLoc)
                If regex.Test(varLoc(i)) Then
                    wks2.Cells(rngCell.Row, "C").Value = varLoc(i)
                    Exit For
                End If
            Next i

        End If

    Next rngCell


End Sub

Artik

[Koszykowa]

Hello Artik,
Many thanks for you help. This code is working exactly as I want.
And I would like to apologise for my late reply and changing the code - thank you for your great help and patience.
Wish you nice day and great start of the week