Copy data from one cell into single cells

Hello Experts,

I have a macro kindly written by byundt which searches for certain data and copies it to another worksheet.  For some reason the macro will not copy the data from the last part of the data from the cell.

I have attached an example of the raw data and the macro I use to extract the relevant data.

I hope you can help.

Sonia BowditchInformation Security OfficerAsked:
Who is Participating?
krishnakrkcConnect With a Mentor Commented:

Try this

Sub kTest()
    Dim ka, k(), i As Long, H, m As Long
    Dim dic As Object, x, y, j As Long
    ka = Worksheets("Raw Data").Range("a1").CurrentRegion.Value2
    H = Worksheets("Format").Range("a1").CurrentRegion.Rows(1).Value2
    ReDim k(1 To UBound(ka, 1), 1 To UBound(H, 2))
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    For i = 1 To UBound(H, 2)
        dic.Item(Trim$(H(1, i))) = i
    For i = 1 To UBound(ka, 1)
        x = Split(ka(i, 1), vbLf)
        For m = 0 To UBound(x)
            If InStr(1, x(m), ":") Then
                y = Split(x(m), ":")
                If dic.exists(Trim$(y(0)) & ":") Then
                    k(i, dic.Item(Trim$(y(0)) & ":")) = y(1)
                End If
            End If
    Worksheets("Format").Range("a2").Resize(UBound(k, 1), dic.Count) = k
End Sub

Open in new window

Sonia BowditchInformation Security OfficerAuthor Commented:
Works perfectly, thank you.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.