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/
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.