Convert Data

[niwat2811]

I have taken the Sheet Data from PDF files and want to convert to a format Sheet Result Thanks for the help.

[Bob Phillips]

Public Sub ProcessData()
Dim ws As Worksheet
Dim branch As String
Dim product As String
Dim subtype As String
Dim assetclass As String
Dim lastrow As Long, nextrow As Long
Dim endrow As Long, startrow As Long
Dim tmp As String
Dim firstaddress As String
Dim i As Long, ii As Long
Dim cell As Range
Dim ary As Variant, aryCnt As Long

Application.ScreenUpdating = False

Set ws = ActiveWorkbook.Worksheets.Add
ws.Range("A1:J1").Value = Array("A/C Number", "Asset Class", "Name", "Credit Limit", _
"Ledger Balance", "Coll. Allocated", "Provision Bal", _
"Product Type", "Sub Type", "Branch")
nextrow = 1

With Worksheets("data")

Set cell = .Columns("A").Find("Branch :", LookAt:=xlPart)
If Not cell Is Nothing Then

firstaddress = cell.Address
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Do

branch = GetValue(cell, "Branch", ":")
product = GetValue(cell.Offset(2, 0), "Product Type", ":")
subtype = GetValue(cell.Offset(3, 0), "Sub Type", ":")
assetclass = Right$(cell.Offset(4, 0).Value, Len(cell.Offset(4, 0).Value) - InStrRev(cell.Offset(4, 0).Value, ": ") - 1)
startrow = cell.Row + 7
Set cell = .Columns("A").Find("---", After:=cell.Offset(7, 0), LookAt:=xlPart)
If cell Is Nothing Then

endrow = lastrow
Else
endrow = cell.Row - 1
End If

For i = startrow To endrow

ary = Split(.Cells(i, "A").Value, " ")
nextrow = nextrow + 1
aryCnt = UBound(ary) - LBound(ary) + 1
ws.Cells(nextrow, "A").Value = "'" & ary(0)
ws.Cells(nextrow, "B").Value = assetclass
ws.Cells(nextrow, "D").Value = ary(UBound(ary) - 3)
ws.Cells(nextrow, "E").Value = ary(UBound(ary) - 2)
ws.Cells(nextrow, "F").Value = ary(UBound(ary) - 1)
ws.Cells(nextrow, "G").Value = ary(UBound(ary) - 0)
ws.Cells(nextrow, "H").Value = product
ws.Cells(nextrow, "I").Value = subtype
ws.Cells(nextrow, "J").Value = branch
tmp = ""
For ii = 1 To aryCnt - 5

tmp = tmp & ary(ii) & " "
Next ii
ws.Cells(nextrow, "C").Value = Trim(tmp)
Next i

Set cell = .Columns("A").Find("Branch :", After:=cell, LookAt:=xlPart)
Loop Until cell Is Nothing Or cell.Address = firstaddress
End If
End With

ws.Columns("A:J").AutoFit

Application.ScreenUpdating = True
End Sub

Function GetValue(cell As Range, id As String, delim As String) As String
Dim tmp As String

tmp = Trim(Replace(Replace(cell.Value, id, "", , 1), delim, ""))
GetValue = Right$(tmp, Len(tmp) - InStr(tmp, " "))
End Function

[niwat2811]

YOU ARE A GENIUS! Thank you so much!

[niwat2811]

I have tried the code above. To improve the use of my work. I can not do it.
Please help me with this task successfully. Thank you very much.

[Bob Phillips]

Is this another requirement, or the real requirements of the first request?

[niwat2811]

This is another requirement. Please help me