Data Fill Routine

The following routine is useful for multiple rows that require the same data adding to each row. The routine lets the user specify the match requirements and then the subsequent data to be copied into the row - this can be one or many cells depending on the individual requirement.

Dim rowTarget, rowSource As Integer

rowTarget = 5
rowSource = 5

'Loop through each source element
Do Until (IsEmpty(Cells(rowSource, 10)))

     'Reset the inner loop counter
     rowTarget = 5

     'Start the second inner loop - each target element
     Do Until (IsEmpty(Cells(rowTarget, 4)))
         'If they match with pre and post appended wild cards
         If (Cells(rowTarget, 4) Like ("*" + Cells(rowSource, 10) + "*")) Then
             'Append the required data to the target row
             Cells(rowTarget, 5) = Cells(rowSource, 11)
         End If

         rowTarget = rowTarget + 1
     Loop

     rowSource = rowSource + 1
Loop