PDA

View Full Version : Solved: Splitting addresses into multiple columns



Beatrix
07-03-2012, 07:50 AM
Hi All ,

I have below code which creates new spreadsheets by pulling data from multiple columns in multiple spreadsheets. That works perfect. However I need to split address fields.

There are 2 main address columns (column number 25-26) in data source and the address should be split between 5 columns (11-12-13-14-15) in template depending on address category flat/house etc. I was wondering if it's possible or not to do this with VBA?: pray2:

I attached 3 spreadsheets below to be clear on this data scenario.

-xml data source ( to pull data)
-template (to create new spreadsheets)
-coding (data map which matches the column numbers between data source and template)


Sub Convert_Cols_From_XMLfiles_to_XLSXfiles()

Dim codeWB As Workbook, xmlWB As Workbook, tmpWB As Workbook
Dim codeWS As Worksheet, xmlWS As Worksheet, tmpWS As Worksheet
Dim ColNums As Range, cll As Range, Col2Copy As Range
Dim i As Long, j As Long, xmlLR As Long, tmpLR As Long, Calc As Long
Dim xmlPath As String, tmpPath As String, tmpFile As String
Dim arrFiles As Variant

With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

xmlPath = "U:\MIS\VBA Project\Final\"
tmpPath = "U:\MIS\VBA Project\Final\ConvertedFromXmlToTmp\"
If Dir(tmpPath, vbDirectory) = "" Then
MkDir tmpPath 'create folder if not exists
Else
On Error Resume Next
Kill tmpPath & "*.*" 'delete all files, if any, in folder if exists
On Error GoTo 0
End If

Set codeWB = ThisWorkbook
Set codeWS = codeWB.Worksheets("coding")
Set ColNums = codeWS.Range("C2:C25")

On Error Resume Next

Set tmpWB = Workbooks("template.xlsx")
If tmpWB Is Nothing Then Set tmpWB = Workbooks.Open(xmlPath & "template.xlsx")
Set tmpWS = tmpWB.Worksheets("template")
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
If tmpLR = 1 Then tmpLR = 2
tmpWS.Range("A2:X" & tmpLR).ClearContents
tmpWB.Save
tmpWB.Close

arrFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True)
If UBound(arrFiles) = 0 Then
MsgBox "No files selected!", vbOKOnly + vbCritical
Exit Sub
End If

On Error GoTo 0

For j = LBound(arrFiles) To UBound(arrFiles)
Set tmpWB = Workbooks.Open(xmlPath & "template.xlsx")
Set tmpWS = tmpWB.Worksheets("template")
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
If tmpLR = 1 Then tmpLR = 2
Set xmlWB = Workbooks.Open(arrFiles(j))
Set xmlWS = xmlWB.Worksheets("xml data source")
xmlLR = xmlWS.Cells(Rows.Count, 1).End(xlUp).Row
If xmlLR = 1 Then GoTo NextFile
i = 1
For Each cll In ColNums
Set Col2Copy = Range(xmlWS.Cells(2, cll.Value), xmlWS.Cells(xmlLR, cll.Value))
Col2Copy.Copy tmpWS.Cells(2, i)
i = i + 1
Next
tmpWS.Range("Q2:Q" & tmpWS.Cells(Rows.Count, 1).End(xlUp).Row).Value = "London"
tmpFile = "tmp_" & j & "_" & xmlWB.Name
With tmpWB
.SaveAs tmpPath & tmpFile, FileFormat:=51
.Close False
End With
xmlWB.Close False
NextFile:
Next

With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = Calc
End With

End Sub



Cheers
Yeliz

CatDaddy
07-03-2012, 02:39 PM
Dim str() as String
str = Split(Range(Cells(1,25)).Text," "))
Range(Cells(1,11)).Value = str(0)
Range(Cells(1,12)).Value = str(1)
'...

Beatrix
07-03-2012, 02:59 PM
Hiya ,

Thanks very much for your response:cloud9: Where exactly do I need to add below lines in the script?:dunno

happy coding:hi:



Dim str() as String
str = Split(Range(Cells(1,25)).Text," "))
Range(Cells(1,11)).Value = str(0)
Range(Cells(1,12)).Value = str(1)
'...

CatDaddy
07-03-2012, 03:15 PM
depends on which stage of your macro you want this to happen

Beatrix
07-05-2012, 09:22 AM
I need to split address fields after new template is produced so do I need to add a new Sub Procedure for the script you gave below?:dunno

Cheers



depends on which stage of your macro you want this to happen

mancubus
07-05-2012, 09:35 AM
Hi Yeliz,

for vba split function:
http://spreadsheetpage.com/index.php/site/tip/the_versatile_split_function/

the UDF Function ExtractElement(str, n, sepChar) here can be used, if split works for your case. but i'm not sure that will help solve your problem.

col Y (25) and Z (26) contain Address1 and Address2 data in xml file.
you want to split these two values amoung 5 columns K thru O (11-12-13-14-15) in template file. (and what about Address3 on col P or col 16?)

an example:
col 25 (xml) : 60a Walford Road
col 26 (xml) : London

how do we split these two strings to fit into five cols (Student_Apartment, Student_HouseName, Student_HouseNumber, Student_Address1, Student_Address2) in template file?

split function splits first string (ie, 60a Walford Road) into 3 parts:
"60a" and
"Walford" and
"Road".

after solving this issue we can find a way to copy splitted data into 5 columns.

cheers...

CatDaddy
07-05-2012, 09:35 AM
yeah that would work

CatDaddy
07-05-2012, 09:38 AM
if apartment letter is always the last letter attached to the number you could use
Left(str(0),Length(str(0))-1)

CodeNinja
07-05-2012, 09:55 AM
I was going to avoid this conversation for fear of complicating things, but since mancubus stepped in and echoed some of my thoughts, I figured I would provide more to fuel to the fire...

Splitting strings or parsing them in this manner is a touchy thing. You really need to define your parameters. For example, if you want street#, Street Name, City, State and Zipcode parsed, you need to concern yourself with how you split each one of them.

Can a road possibly have more than 1 word to it? New Falls Road or Old Welsh Road or West Dekalb Pike? Can a city have more than one word? New Brittain, PA, New South Wales, PA, Gloucester County NJ? Does the zip code have 5 or 9 numbers, and does it have a -? What about foreign countries that have a different address.

All of these items must be considered when writing your parsing script.

That is my $0.02

CatDaddy
07-05-2012, 10:17 AM
thats a good point

Beatrix
07-06-2012, 09:10 AM
Thanks very much for all your replies guys..:friends:

I couldn't work it out how to define the parameters and preferred to ask people in forum as it always gives me better understanding. At least now I know it's not just my lack of my knowledge, the task itself is complicated as well. I'll keep working on that hope I can find a way to specify address parameters as the addresses in London makes me confused:doh:

Cheers
Yeliz

Beatrix
09-13-2012, 09:02 AM
Hi Everyone ,

I just wanted to let you know I managed to get the address parameter split into 5 columns by chasing after 12 different scripts and having lots of google and vbax support..It took me almost 2 months to complete this task but I've learned a lot..Sample file is attached with 12 scripts for those who needs to work on similar data scenarios..

Cheers
Yeliz

mancubus
09-13-2012, 01:54 PM
thanks for the feedback.

Beatrix
09-13-2012, 02:34 PM
pleasure :)

Beatrix
09-24-2012, 03:42 AM
Hi mancubus ,

As I've finished working on splitting address fields into 5 columns:thumb, now I need to integrate this split data with copy-paste process solved in previous thread below.:cool:

http://www.vbaexpress.com/forum/showthread.php?t=42336

:think:I thought I could create a temporary sheet to split address into 5 columns then delete that tab after copying split data to the template produced by coding.xlsm. However I'm not sure if I can run all scripts in one go ? Wondering the scripts for splitting address fields might be structured in coding.xlsm or not: pray2: Any ideasss??

zip files are attached.

Cheersss:hi:
Yeliz



Hi Yeliz,

for vba split function:
http://spreadsheetpage.com/index.php/site/tip/the_versatile_split_function/

the UDF Function ExtractElement(str, n, sepChar) here can be used, if split works for your case. but i'm not sure that will help solve your problem.

col Y (25) and Z (26) contain Address1 and Address2 data in xml file.
you want to split these two values amoung 5 columns K thru O (11-12-13-14-15) in template file. (and what about Address3 on col P or col 16?)

an example:
col 25 (xml) : 60a Walford Road
col 26 (xml) : London

how do we split these two strings to fit into five cols (Student_Apartment, Student_HouseName, Student_HouseNumber, Student_Address1, Student_Address2) in template file?

split function splits first string (ie, 60a Walford Road) into 3 parts:
"60a" and
"Walford" and
"Road".

after solving this issue we can find a way to copy splitted data into 5 columns.

cheers...

mancubus
09-24-2012, 03:24 PM
hi,

attached file in post #12 has a sheet, a helper sheet i believe, named "split" which is different than the template file in post #1.

if you can post a file that demonstrates before and after situations of converted sheet, i think we can easily adopt the codes.

Beatrix
09-25-2012, 10:03 AM
Hi ,

I've attached zip files including after scenario.

the files named coding, template and xml data source need to be open. They produce tmp_1_....xlsx. I need to combine the scripts in coding.xlsm and splitting address.xlsm to get to final stage. I copied after scenario.

thanksss very much for your time. Much appreciated:bow:




hi,

attached file in post #12 has a sheet, a helper sheet i believe, named "split" which is different than the template file in post #1.

if you can post a file that demonstrates before and after situations of converted sheet, i think we can easily adopt the codes.

mancubus
09-26-2012, 01:17 AM
hi.

modified existing Convert_Cols_From_XMLfiles_to_XLSXfiles to process multiple procedures.

i modifies 2-3 three sub procedures to suit helper worksheet.

HTH

file is attached.

procedures may be simplified. i think you can do that later as your skills improve.


Sub Convert_Cols_From_XMLfiles_to_XLSXfiles()

Dim codeWB As Workbook, xmlWB As Workbook, tmpWB As Workbook
Dim codeWS As Worksheet, xmlWS As Worksheet, tmpWS As Worksheet
Dim wsSplit As Worksheet
Dim ColNums As Range, cll As Range, Col2Copy As Range
Dim i As Long, j As Long, xmlLR As Long, tmpLR As Long, Calc As Long
Dim xmlPath As String, tmpPath As String, tmpFile As String
Dim arrFiles As Variant

With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

xmlPath = "U:\MIS\VBA Project\Final\"
tmpPath = "U:\MIS\VBA Project\Final\ConvertedFromXmlToTmp\"

If Dir(tmpPath, vbDirectory) = "" Then
MkDir tmpPath 'create folder if not exists
Else
On Error Resume Next
Kill tmpPath & "*.*" 'delete all files, if any, in folder if exists
On Error GoTo 0
End If

Set codeWB = ThisWorkbook
Set codeWS = codeWB.Worksheets("coding")
Set ColNums = codeWS.Range("C2:C25")

On Error Resume Next

Set tmpWB = Workbooks("template.xlsx")
If tmpWB Is Nothing Then Set tmpWB = Workbooks.Open(xmlPath & "template.xlsx")
Set tmpWS = tmpWB.Worksheets("template")
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
If tmpLR = 1 Then tmpLR = 2
tmpWS.Range("A2:X" & tmpLR).ClearContents
tmpWB.Save
tmpWB.Close

arrFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True)
If UBound(arrFiles) = 0 Then
MsgBox "No files selected!", vbOKOnly + vbCritical
Exit Sub
End If

On Error GoTo 0

For j = LBound(arrFiles) To UBound(arrFiles)
Set tmpWB = Workbooks.Open(xmlPath & "template.xlsx")
Set tmpWS = tmpWB.Worksheets("template")
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
If tmpLR = 1 Then tmpLR = 2
Set xmlWB = Workbooks.Open(arrFiles(j))
Set xmlWS = xmlWB.Worksheets("xml data source")
xmlLR = xmlWS.Cells(Rows.Count, 1).End(xlUp).Row
If xmlLR = 1 Then GoTo NextFile
i = 1
For Each cll In ColNums
Set Col2Copy = Range(xmlWS.Cells(2, cll.Value), xmlWS.Cells(xmlLR, cll.Value))
Col2Copy.Copy tmpWS.Cells(2, i)
i = i + 1
Next
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
tmpWS.Range("Q2:Q" & tmpLR).Value = "London"
tmpFile = "tmp_" & j & "_" & xmlWB.Name
With tmpWB
.Activate
.SaveAs tmpPath & tmpFile, FileFormat:=51
Set wsSplit = .Sheets.Add 'create helper sheet
wsSplit.Name = "split" 'rename to suit existing procedures
tmpWS.Range("N1:O" & tmpLR).Copy wsSplit.Range("A1")
wsSplit.Activate
Call call_procs 'call all split n parse procedures
wsSplit.Range("C2:G" & tmpLR).Copy tmpWS.Range("K2")
wsSplit.Delete ' delete helper sheet
.Close True
End With
xmlWB.Close False
NextFile:
Next

With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = Calc
End With

End Sub




Sub call_procs()
Call parseadd
Call parseadd2
Call InsertColumn
Call SplittingFlat
Call DelLondon
'Call SplittingNumber
Call SplittingRoad
Call ConcatCols
Call InsertColumn2
Call SplittingHouse
Call ConcatCols2
Call SplittingRoad2
End Sub

Beatrix
09-26-2012, 03:06 AM
mancubus mancubus mancubus :cloud9:

that's working perfectly!!:thumb

I know some of procedures could have been simplified but I need to have better VBA skills for that.. I'm on it!:whip

once again many many thanksss:bow:

Yeliz




hi.

modified existing Convert_Cols_From_XMLfiles_to_XLSXfiles to process multiple procedures.

i modifies 2-3 three sub procedures to suit helper worksheet.

HTH

file is attached.

procedures may be simplified. i think you can do that later as your skills improve.


Sub Convert_Cols_From_XMLfiles_to_XLSXfiles()

Dim codeWB As Workbook, xmlWB As Workbook, tmpWB As Workbook
Dim codeWS As Worksheet, xmlWS As Worksheet, tmpWS As Worksheet
Dim wsSplit As Worksheet
Dim ColNums As Range, cll As Range, Col2Copy As Range
Dim i As Long, j As Long, xmlLR As Long, tmpLR As Long, Calc As Long
Dim xmlPath As String, tmpPath As String, tmpFile As String
Dim arrFiles As Variant

With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

xmlPath = "U:\MIS\VBA Project\Final\"
tmpPath = "U:\MIS\VBA Project\Final\ConvertedFromXmlToTmp\"

If Dir(tmpPath, vbDirectory) = "" Then
MkDir tmpPath 'create folder if not exists
Else
On Error Resume Next
Kill tmpPath & "*.*" 'delete all files, if any, in folder if exists
On Error GoTo 0
End If

Set codeWB = ThisWorkbook
Set codeWS = codeWB.Worksheets("coding")
Set ColNums = codeWS.Range("C2:C25")

On Error Resume Next

Set tmpWB = Workbooks("template.xlsx")
If tmpWB Is Nothing Then Set tmpWB = Workbooks.Open(xmlPath & "template.xlsx")
Set tmpWS = tmpWB.Worksheets("template")
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
If tmpLR = 1 Then tmpLR = 2
tmpWS.Range("A2:X" & tmpLR).ClearContents
tmpWB.Save
tmpWB.Close

arrFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True)
If UBound(arrFiles) = 0 Then
MsgBox "No files selected!", vbOKOnly + vbCritical
Exit Sub
End If

On Error GoTo 0

For j = LBound(arrFiles) To UBound(arrFiles)
Set tmpWB = Workbooks.Open(xmlPath & "template.xlsx")
Set tmpWS = tmpWB.Worksheets("template")
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
If tmpLR = 1 Then tmpLR = 2
Set xmlWB = Workbooks.Open(arrFiles(j))
Set xmlWS = xmlWB.Worksheets("xml data source")
xmlLR = xmlWS.Cells(Rows.Count, 1).End(xlUp).Row
If xmlLR = 1 Then GoTo NextFile
i = 1
For Each cll In ColNums
Set Col2Copy = Range(xmlWS.Cells(2, cll.Value), xmlWS.Cells(xmlLR, cll.Value))
Col2Copy.Copy tmpWS.Cells(2, i)
i = i + 1
Next
tmpLR = tmpWS.Cells(Rows.Count, 1).End(xlUp).Row
tmpWS.Range("Q2:Q" & tmpLR).Value = "London"
tmpFile = "tmp_" & j & "_" & xmlWB.Name
With tmpWB
.Activate
.SaveAs tmpPath & tmpFile, FileFormat:=51
Set wsSplit = .Sheets.Add 'create helper sheet
wsSplit.Name = "split" 'rename to suit existing procedures
tmpWS.Range("N1:O" & tmpLR).Copy wsSplit.Range("A1")
wsSplit.Activate
Call call_procs 'call all split n parse procedures
wsSplit.Range("C2:G" & tmpLR).Copy tmpWS.Range("K2")
wsSplit.Delete ' delete helper sheet
.Close True
End With
xmlWB.Close False
NextFile:
Next

With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = Calc
End With

End Sub



Sub call_procs()
Call parseadd
Call parseadd2
Call InsertColumn
Call SplittingFlat
Call DelLondon
'Call SplittingNumber
Call SplittingRoad
Call ConcatCols
Call InsertColumn2
Call SplittingHouse
Call ConcatCols2
Call SplittingRoad2
End Sub

mancubus
09-26-2012, 04:28 AM
you're most wellcome. thanks for the feedback.

IanBurton
02-10-2014, 07:27 AM
you're most wellcome. thanks for the feedback.

Mancubus, thanks for posting the address split functions. It is exactly what I was looking for. Best wishes. Ian

mancubus
02-10-2014, 07:30 AM
you are welcome. thanks to John Walkenbach @ http://spreadsheetpage.com/