copy paste code correction

Another option. The 'acropole' and 'Acropole' - the same thing, right?

Originally Posted by nilem

Another option. The 'acropole' and 'Acropole' - the same thing, right?

Simply magic! this works excellent!

Hello,

I would like to make one change to that code if it is possible.

When it is executed, I want to copy-paste to only the one that are blank... we can set the column B as a check point...

so if the cell is blank there it should copy-paste there...
if not, then it should do nothing with it.

I hope it is easy to understand what I mean...

Thank you in advance...

try this

Sub ertert()
Dim x, i&, j&, s: Application.ScreenUpdating = False
x = Range("A1:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        If Len(x(i, 3)) Then .Item(Trim(x(i, 3))) = Array(x(i, 2), x(i, 3), x(i, 4), x(i, 5))
    Next i

    For i = 1 To UBound(x)
        If Len(Trim(x(i, 2))) = 0 Then 'new line
            s = Split(x(i, 1))
            For j = 0 To UBound(s)
                If .Exists(Trim(s(j))) Then Cells(i, 2).Resize(, 4).Value = .Item(Trim(s(j))): Exit For
            Next j
        End If
    Next i
End With: Application.ScreenUpdating = True
End Sub

Perfect! thank you

Hello,

is it possible to make one change... ?

The above code, searches for only one keyword... but if i have a phrase in column C this will not detect it.

Please see an example attached! run the below code in it

Sub ertert()
Dim x, i&, j&, s: Application.ScreenUpdating = False
x = Range("A1:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        If Len(x(i, 3)) Then .Item(Trim(x(i, 3))) = Array(x(i, 2), x(i, 3), x(i, 4), x(i, 5))
    Next i

    For i = 1 To UBound(x)
        If Len(Trim(x(i, 2))) = 0 Then 'new line
            s = Split(x(i, 1))
            For j = 0 To UBound(s)
                If .Exists(Trim(s(j))) Then Cells(i, 2).Resize(, 4).Value = .Item(Trim(s(j))): Exit For
            Next j
        End If
    Next i
End With: Application.ScreenUpdating = True
End Sub

Thank you for your help.

wrong file attached... here is the correct one

see attachment

excellent! thank you!

Hello,

the problem that I see now, is that if I have a small word for example "niki" it will detect it in "Thessaloniki" ...

so, with the old code we didn't had the above problem but if we had a phrase "hotels in thessaloniki" we couldn't detect it...
and with the new one, we can detect a phrase but have the above problem

is it possible to combine the two and have a perfect result ?

thank you!

maybe so (see attached file)

Hello,

I would like to know, if it is possible to make the code a little bit more advanced.
In the attached file you will see an example...

Thank you

Hi, Yiannis. Check it out.

I made a change in the code... from

If Len(x(i, 3)) Then

to

If Len(x(i, 3)) And Len(x(i, 4)) Then

because I need to check only for Negative Elements where B,C,D and E are with data.

The problem is that now, if we have data only in B and C for some reason they are being deleted... see in attached file.