Need help for creating a Macro

Hi Michael,

Welcome to the Forum!

If no one solves your issue in the interim - I'll look at this tomorrow

Hi Michael,

Is your sample correct? You've got as many as 5 descriptions in the top rows of the data element sheet and none in the last rows??

There are three rows with no description after I spread them out. So, I assumed that your sample was incorrect - if, I'm right then try this:

Sub MRossely(): Dim wf As Worksheet, wd As Worksheet, F As Range, D As Range, r As Long
Dim IDF As String: Set wf = Sheets("Functional"): Set wd = Sheets("Data Element")

For Each D In wf.Range("C2:C" & wf.Range("C" & Rows.Count).End(xlUp).Row): IDF = D.Offset(0, -2)
        Set F = wd.Range("C:C").Find(D, , , xlWhole)
        If Not F Is Nothing Then
        r = F.Row
        Do
        F.Offset(0, 4) = F.Offset(0, 4) & " " & IDF
        Set F = wd.Range("C:C").FindNext(F)
        
        Loop Until F Is Nothing Or F.Row = r
        End If
Next D
End Sub

Ill look again tomorrow.

Hi MIchael,


Try this:

Sub MRossely(): Dim wf As Worksheet, wd As Worksheet, F As Range, D As Range, r As Long
Dim IDF As String: Set wf = Sheets("Functional"): Set wd = Sheets("Data Element")

For Each D In wf.Range("C2:C" & wf.Range("C" & Rows.Count).End(xlUp).Row): IDF = D.Offset(0, -2)
        Set F = wd.Range("C:C").Find(D, , , xlPart)
        If Not F Is Nothing Then
        r = F.Row
        Do
        F.Offset(0, 4) = F.Offset(0, 4) & " " & IDF
        Set F = wd.Range("C:C").FindNext(F)
        
        Loop Until F Is Nothing Or F.Row = r
        End If
Next D
End Sub