I have huge amount of data in below format.
**M A Enterprises ~**
Member No: M-551/IV/A
Category: Food and vegetables
Year of Established: 1984
Address: Address line 1
Address Line 2
Address Line 3
Address Line 4
Address Line 5
Phone: 11111111, 22222222
Fax: 33333333
Email: [email protected]
Website:www.somewebsite.com
Executive1: Mr. Ashok Kumar
Designation: Owner
Mobile: 9999999999
Executive2: Rahul Bhai
Designation: Director
Mobile: 3333333333
Product: food product processing
Rawmaterial: Ss Hot Rolled
**A B Enterprises ~**
Member No: M-552/IV/A
Category: Food and vegetables
Year of Established: 1984
Address: Address line 1
Address Line 2
Address Line 3
Address Line 4
Address Line 5
Phone: 11111111, 22222222
Fax: 33333333
Email: [email protected]
Executive1: Mr. Ashok Kumar
Mobile: 9999999999
Executive2: Rahul Bhai
Mobile: 3333333333
Product: food product processing
As you can see, there are 2 sets of data here. 1st line is a company name (in bold letters). It has no FIELD NAME, but a trailing "~" along with space after company name.
Total of maximum 17 fields (company name, member no, Category etc) in each set. Second set has only 16 fields (raw material is not there)
Some fields are not present in every set, Like Fax, Designation, Website, Email.
There is no GAP (space, paragraph) between 2 sets. Every set either ends with "Product" or "Rawmaterial". "Rawmaterial is not that important information, If needed, I can drop this.
Address lines are flexible, it can be 3 to 5 lines, but does not exceed 6 or 7 in any of the entries.
Another issue is "Designation" which appears 2 times in some entries. First one comes after "Executive1" and second comes after "Executive2". Same thing with "Mobile".
Currently data is in PLAIN TEXT format, but i could pull it in excel with ":" as delimiter. Thereafter there will be 2 columns, A1=Member No and B1=M-551/IV/A (and so on), Cant help with company name as there is no ":" sign in it.
Thousands of sets are there, so i need to find a way to do this anyhow.
What I am trying to achieve:
In Excel,
and so on, row by row, till the final set.
and so on...
Same with other fields.
I did my best to try VLookup, Match, Find functions, but not getting any results.
Any help would be great. Thanks.
Below vba code should help. It's been written under the assumption that "~" would appear only in Company Name.
Sub sTexttoExcel()
'Input File Path
filePath = "C:\CustomerData.txt"
Dim fso As FileSystemObject
Dim HeaderName() As String
Dim cellcontent As String
Dim CompanyDetails(2) As String
Dim RowCount, ColoumnCount As Integer
Set fso = New FileSystemObject
Set txtStream = fso.OpenTextFile(filePath, ForReading, False)
'Initialise Row and Column count
RowCount = 1
ColoumnCount = 1
coloumnheadercount = 0
RowHeaderCount = 0
'Loop through contents of text file to print headers
Do While Not txtStream.AtEndOfStream
cellcontent = txtStream.ReadLine
If InStr(1, cellcontent, "~", vbTextCompare) <> 0 Then
'Print the header row
RowHeaderCount = RowHeaderCount + 1
coloumnheadercount = coloumnheadercount + 1
If RowHeaderCount = 2 Then Exit Do
Cells(1, coloumnheadercount) = "Company Name"
ElseIf InStr(1, cellcontent, ":", vbTextCompare) <> 0 Then
coloumnheadercount = coloumnheadercount + 1
ReDim Preserve HeaderName(1 To coloumnheadercount)
HeaderName(coloumnheadercount - 1) = Split(cellcontent, ":")(0)
Cells(1, coloumnheadercount) = Split(cellcontent, ":")(0)
End If
Loop
txtStream.Close
Set txtStream = fso.OpenTextFile(filePath, ForReading, False)
'Loop through contents of text file
Do While Not txtStream.AtEndOfStream
cellcontent = txtStream.ReadLine
'Store details of Executives in a seperate array
If InStr(1, cellcontent, "Executive", vbTextCompare) <> 0 Then
CompanyDetails(0) = cellcontent
End If
If InStr(1, cellcontent, "Designation", vbTextCompare) <> 0 Then
CompanyDetails(1) = cellcontent
End If
If InStr(1, cellcontent, "Mobile", vbTextCompare) <> 0 Then
CompanyDetails(2) = cellcontent
End If
'Check if it is a company name
If InStr(1, cellcontent, "~", vbTextCompare) <> 0 Then
RowCount = RowCount + 1
ColoumnCount = 1
Cells(RowCount, ColoumnCount) = cellcontent
'Check if it has the text 'Address'
ElseIf InStr(1, cellcontent, "Address", vbTextCompare) <> 0 Then
If InStr(1, cellcontent, ":", vbTextCompare) <> 0 Then
ColoumnCount = ColoumnCount + 1
Cells(RowCount, ColoumnCount) = Cells(RowCount, ColoumnCount) & Trim(Split(cellcontent, ":")(1)) & vbCrLf
Else
Cells(RowCount, ColoumnCount) = Cells(RowCount, ColoumnCount) & cellcontent & vbCrLf
End If
'Check if it has the text 'Designation'
ElseIf InStr(1, cellcontent, "Designation", vbTextCompare) <> 0 Then
ColoumnCount = ColoumnCount + 1
If InStr(1, CompanyDetails(0), "Executive1", vbTextCompare) <> 0 Then
Call writeCell(cellcontent, RowCount, 11)
ElseIf InStr(1, CompanyDetails(0), "Executive2", vbTextCompare) <> 0 Then
Call writeCell(cellcontent, RowCount, 14)
End If
'Check if it has the text 'Mobile'
ElseIf InStr(1, cellcontent, "Mobile", vbTextCompare) <> 0 Then
ColoumnCount = ColoumnCount + 1
If InStr(1, CompanyDetails(0), "Executive1", vbTextCompare) <> 0 Then
Call writeCell(cellcontent, RowCount, 12)
ElseIf InStr(1, CompanyDetails(0), "Executive2", vbTextCompare) <> 0 Then
Call writeCell(cellcontent, RowCount, 15)
End If
Else
ColoumnCount = ColoumnCount + 1
For i = 1 To UBound(HeaderName) - 1
If InStr(1, cellcontent, HeaderName(i), vbTextCompare) <> 0 Then Call writeCell(cellcontent, RowCount, i + 1)
Next i
End If
Loop
txtStream.Close
End Sub
Sub writeCell(ByVal cellcontent As String, ByVal RowCount As Integer, ByVal ColoumnCount As Integer)
Cells(RowCount, ColoumnCount) = Trim(Split(cellcontent, ":")(1))
End Sub