Solved: Format Extracted Data

[gnod]

Hi,

Sheet1 is the extracted data from the system and Sheet2 is the output..
How can i format the Sheet1 into Sheet2?



Thanks..

[mvidas]

gnod,

It would be easy to do, with the exception of the phone number getting appended to the end of the address fields. The phone numbers there dont follow a pattern that I could check for, I cant just test for >x number of digits (long addresses), and I can't even check for the # symbol. If you cant think of a good way I could check for it (ie will it ALWAYS begin with "cel#" or "tel#") then I'll just post this code, which will just put the telephone number into the address field:[vba]Sub gnod()
Dim WS As Worksheet, FWS As Worksheet
Dim PUDate As Date, Remitters As Range, CLL As Range, RCnt As Long
Set WS = ActiveSheet 'sheet to perform this on
On Error Resume Next
Set Remitters = WS.Columns("A").SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If Remitters Is Nothing Then Exit Sub
Set FWS = Sheets.Add(After:=Sheets(Sheets.Count)) 'sheet with formatted data
FWS.Range("A1:K1").Value = Array("AWB/CN#", "AREA CODE", "CONSIGNEE" & _
"/BENEFICIARY'S NAME", "REMITTER/SHIPPER NAME", "ADDRESS", "PICK UP DATE", _
"DEC. VALUE", "PKG. CODE", "TEL. NUMBER", "REFERENCE NO.", "MESSAGES")
FWS.Range("A:B,G:G").NumberFormat = "General"
FWS.Range("C:E,H:K").NumberFormat = "@" 'text
FWS.Range("F:F").NumberFormat = "dd-mmm-yy"
FWS.Cells.Font.Name = "Verdana"
FWS.Cells.Font.Size = 8
FWS.Rows(1).Font.Bold = True
FWS.Rows(1).HorizontalAlignment = xlCenter
PUDate = WS.Range("F5").Value
RCnt = 0
For Each CLL In Remitters.Cells
RCnt = RCnt + 1
With FWS.Range("A1").Offset(RCnt, 0) 'col A of next line in Formatted sheet
.Offset(0, 2).Value = Trim(CLL.Offset(1, 3).Value) & " " & _
Trim(CLL.Offset(1, 6).Value) 'beneficiary
.Offset(0, 3).Value = Trim(CLL.Offset(0, 3).Value) 'remitter
.Offset(0, 4).Value = Trim(CLL.Offset(3, 3).Value) & " " & _
Trim(CLL.Offset(4, 3).Value) & " " & Trim(CLL.Offset(5, 3).Value) 'address
.Offset(0, 5).Value = PUDate 'pick up date
.Offset(0, 6).Value = CLL.Offset(0, 11).Value 'dec. value
'.offset(0,8).value= 'phone number
.Offset(0, 9).Value = CLL.Offset(0, 2).Value 'reference no.
End With
Next
FWS.Columns.AutoFit
End Sub[/vba]If you can figure out a good way to determine the phone number cells, I can incorporate that in.

Matt

[gnod]

Thanks, mvidas
I'm debugging your code trying to understand but i'm confuse with this code
[VBA]Set Remitters = WS.Columns("A").SpecialCells(xlCellTypeConstants, 23)[/VBA]

when i scan the extracted data, it doesn't have a pattern for tel numbers like what you said, sometimes it appears as "Tel#" or "T#" or "Cel#" or "Cel." or "CP#".. is it possible to check all of this then put it in the column tel numbers..


Thanks..

[mvidas]

That SpecialCells call is the same as doing the following:
-Select all of column A (where your 1,2,3,4,5 numbers were)
-Press F5 (or go to Edit, then Go To)
-Click the Special button
-Select the Constants radio button, then click OK.

The cells that are selected there are the ones I'm setting to the range "Remitters", as I use those cells as the 'anchor' while retrieving the rest of the data. I surround that call with the On Error statements, as it will generate an error if there are no cells with constants in column A, then I check to see if the Range is nothing (meaning no cells with constants).

I think I can add some code to test for those patterns for phone number (and make it relatively simply to add more variations), I'll post back in a few minutes
matt

[mvidas]

Ok, give this a try, hopefully you can see how I'm checking for those patterns, so you can add your own later if need be:[vba]Sub gnod()
Dim WS As Worksheet, FWS As Worksheet, Addr As String, Addr3 As String
Dim PUDate As Date, Remitters As Range, CLL As Range, RCnt As Long
Set WS = ActiveSheet 'sheet to perform this on
On Error Resume Next
Set Remitters = WS.Columns("A").SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If Remitters Is Nothing Then Exit Sub
Set FWS = Sheets.Add(After:=Sheets(Sheets.Count)) 'sheet with formatted data
FWS.Range("A1:K1").Value = Array("AWB/CN#", "AREA CODE", "CONSIGNEE" & _
"/BENEFICIARY'S NAME", "REMITTER/SHIPPER NAME", "ADDRESS", "PICK UP DATE", _
"DEC. VALUE", "PKG. CODE", "TEL. NUMBER", "REFERENCE NO.", "MESSAGES")
FWS.Range("A:B,G:G").NumberFormat = "General"
FWS.Range("C:E,H:K").NumberFormat = "@" 'text
FWS.Range("F:F").NumberFormat = "dd-mmm-yy"
FWS.Cells.Font.Name = "Verdana"
FWS.Cells.Font.Size = 8
FWS.Rows(1).Font.Bold = True
FWS.Rows(1).HorizontalAlignment = xlCenter
PUDate = WS.Range("F5").Value
RCnt = 0
For Each CLL In Remitters.Cells
RCnt = RCnt + 1
With FWS.Range("A1").Offset(RCnt, 0) 'col A of next line in Formatted sheet
.Offset(0, 2).Value = Trim(CLL.Offset(1, 3).Value) & " " & _
Trim(CLL.Offset(1, 6).Value) 'beneficiary
.Offset(0, 3).Value = Trim(CLL.Offset(0, 3).Value) 'remitter
Addr = Trim(CLL.Offset(3, 3).Value) & " " & Trim(CLL.Offset(4, 3).Value) 'addr lines 1+2
Addr3 = Trim(CLL.Offset(5, 3).Value) '3rd addr line (to test for phone number)
Select Case True
Case Left(LCase(Addr3), 4) = "Cel.", Left(LCase(Addr3), 4) = "tel#", _
Left(LCase(Addr3), 4) = "cel#" 'the 4-character identifiers
Addr3 = Mid(Addr3, 5)
Case Left(LCase(Addr3), 3) = "cp#" 'the 3-character identifiers
Addr3 = Mid(Addr3, 4)
Case Left(LCase(Addr3), 2) = "t#", Left(LCase(Addr3), 2) = "c#" '2-characters
Addr3 = Mid(Addr3, 3)
Case Else 'no pattern met, must be an address line
Addr = Trim(Addr & " " & Addr3)
Addr3 = ""
End Select
.Offset(0, 4).Value = Addr 'address
.Offset(0, 5).Value = PUDate 'pick up date
.Offset(0, 6).Value = CLL.Offset(0, 11).Value 'dec. value
.Offset(0, 8).Value = Addr3 'telephone
.Offset(0, 9).Value = CLL.Offset(0, 2).Value 'reference no.
End With
Next
FWS.Columns.AutoFit
End Sub[/vba]Matt

[gnod]

Thanks, matt..
what if the 3rd of the addr doesn't begin with those pattern because your using a Left function? (for ex: PHILS TEL#046-4712784)
and sometimes the data for tel no. is on the 2nd line of addr..

Sorry for incomplete info

[mvidas]

Sorry for incomplete info

That is ok, it doesnt sound like you're the source of the workbook, you're just finding exceptions to my assumed rules In a perfect world I'd say ask your source to create a telephone number field! But as this world is far from perfect, I'll help you at least get around that

I've got to run to a (hopefully short) meeting right now, I have an idea of how to do this so I'll give it a try after

[gnod]

you're right.. i'm not the source..
thanks for helping but i also try to solve my problem ..
so i can be as great as you are..


Thanks..

[mvidas]

Ok, I got a good working version here, though if there are 2 phone numbers listed for an account it will only grab the first (I wasn't sure what you wanted done in that case) and will now put the second into the address field again. If you think there could be 4 address lines, change "for i = 3 to 5" to "for i = 3 to 6". I also created a function to help look through each address field for the variants of phone numbers (and only one line of code to list them, should you find any more). So it looks for "tel#"/etc in the address line, and will return what comes after it (even if the field says "phils tel#1234567890"--doesnt use the left function anymore). Give this a try, let me know how it works out for you and any additions you'd like:[vba]Sub gnod()
Dim WS As Worksheet, FWS As Worksheet, Remitters As Range, CLL As Range
Dim Addr As String, tAddr As String, TelNo As String, TelPos As Long
Dim PUDate As Date, RCnt As Long, i As Long
Set WS = ActiveSheet 'sheet to perform this on
On Error Resume Next
Set Remitters = WS.Columns("A").SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If Remitters Is Nothing Then Exit Sub
Set FWS = Sheets.Add(After:=Sheets(Sheets.Count)) 'sheet with formatted data
FWS.Range("A1:K1").Value = Array("AWB/CN#", "AREA CODE", "CONSIGNEE" & _
"/BENEFICIARY'S NAME", "REMITTER/SHIPPER NAME", "ADDRESS", "PICK UP DATE", _
"DEC. VALUE", "PKG. CODE", "TEL. NUMBER", "REFERENCE NO.", "MESSAGES")
FWS.Range("A:B,G:G").NumberFormat = "General"
FWS.Range("C:E,H:K").NumberFormat = "@" 'text
FWS.Range("F:F").NumberFormat = "dd-mmm-yy"
FWS.Cells.Font.Name = "Verdana"
FWS.Cells.Font.Size = 8
FWS.Rows(1).Font.Bold = True
FWS.Rows(1).HorizontalAlignment = xlCenter
PUDate = WS.Range("F5").Value
RCnt = 0
For Each CLL In Remitters.Cells
RCnt = RCnt + 1
With FWS.Range("A1").Offset(RCnt, 0) 'col A of next line in Formatted sheet
.Offset(0, 2).Value = Trim(CLL.Offset(1, 3).Value) & " " & _
Trim(CLL.Offset(1, 6).Value) 'beneficiary
.Offset(0, 3).Value = Trim(CLL.Offset(0, 3).Value) 'remitter
TelNo = ""
Addr = ""
For i = 3 To 5
tAddr = Trim(CLL.Offset(i, 3).Text) 'address line 1
If Len(TelNo) = 0 Then
TelPos = InStrMultiAfter(tAddr, "cel.", "tel#", "cel#", "cp#", _
"t#", "c#")
If TelPos > 0 Then
TelNo = Mid(tAddr, TelPos)
Else
Addr = Addr & " " & tAddr
End If
Else
Addr = Addr & " " & tAddr
End If
Next
Addr = Trim(Addr)
.Offset(0, 4).Value = Addr 'address
.Offset(0, 5).Value = PUDate 'pick up date
.Offset(0, 6).Value = CLL.Offset(0, 11).Value 'dec. value
.Offset(0, 8).Value = TelNo 'telephone
.Offset(0, 9).Value = CLL.Offset(0, 2).Value 'reference no.
End With
Next
FWS.Columns.AutoFit
End Sub
Function InStrMultiAfter(ByVal OrigStr As String, ParamArray SubStrs() As Variant) As Long
Dim i As Long, iPos As Long
For i = LBound(SubStrs) To UBound(SubStrs)
iPos = InStr(1, OrigStr, SubStrs(i), vbTextCompare)
If iPos > 0 Then
InStrMultiAfter = iPos + Len(SubStrs(i)) 'return character position after substring
Exit Function
End If
Next
End Function[/vba]Matt

[gnod]

It works..
regarding for 2 phone numbers or more, is it possible to all phone numbers delimited by "/" in the Tel No column.. (for ex: 09151234567 / 09182468123)..

Thanks..

[mvidas]

Sure thing. Change the "For i = 3 to 5" block to:[vba] For i = 3 To 5
tAddr = Trim(CLL.Offset(i, 3).Text) 'address line 1
TelPos = InStrMultiAfter(tAddr, "cel.", "tel#", "cel#", "cp#", _
"t#", "c#")
If TelPos > 0 Then
TelNo = TelNo & IIf(Len(TelNo) = 0, "", " \ ") & Mid(tAddr, TelPos)
Else
Addr = Addr & " " & tAddr
End If
Next[/vba]Keep em coming

[gnod]

Thanks..
You are great.. Can you be my mentor?

[mvidas]

Nah, probably not a good idea, mentor's usually have to have their **** together, I never quite figured out how to do it.
I'm happy to help though and don't forget to mark this solved (doesn't mean you still can't add to the question)

[gnod]

Ok.. Thanks for helping..