Originally Posted by
mancubus
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.
[vba]
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
[/vba]
[vba]
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
[/vba]
Reply With Quote
Where exactly do I need to add below lines in the script?
, now I need to integrate this split data with copy-paste process solved in previous thread below.
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
