Hey all!


I have a table which contains data from xml files.
This table has 12 columns.

I'm trying to create a vba code which will do the following:

1. delete the first column table.
2. delete blank rows.
3. add a column next to column 3 in order to format data from column 3 as =TEXT([@column3],"000000000").
4. delete column 3.
5. Rename (new) column 3 as "ApplicantVatNumber".
6. Insert 3 columns right named as "Skroutz", "Mickey", 'Mini".
7. do a vlookup in all 3 new columns using as key the column 3 and table array from respective sheets in other workbook.
8. Split table in multiple workbooks based on the value in column A. New workbooks have to be named as "Walt_Disney_X.xlsx" where X is the value in column A. These workbooks have to be stored in folders that i will define.
9. Keep the original sheet.


This my code but, aparently, doesn't work:


Sub FormatTable()
'Delete the first column
Columns(1).Delete
'Delete blank rows
Rows.SpecialCells(xlCellTypeBlanks).Delete
'Add column next to column C
Columns(3).Insert
'Format data in new column
Range("D2").Formula = "=TEXT([@column3],""000000000"")"
'Delete column C
Columns(3).Delete
'Rename column D as "ApplicantVatNumber"
Columns(3).Name = "ApplicantVatNumber"
'Insert 3 columns to the right
Columns(4).Insert
Columns(5).Insert
Columns(6).Insert
'Name new columns
Columns(4).Name = "Skroutz"
Columns(5).Name = "Mickey"
Columns(6).Name = "Mini"
'Do vlookup using column C as key
Range("Skroutz2:Skroutz" & Cells(Rows.Count, "C").End(xlUp).Row).Formula = "=iferror(VLOOKUP(C2,'path to xlsx'sheet,2,FALSE),'0'"
Range("Mickey2:Mickey" & Cells(Rows.Count, "C").End(xlUp).Row).Formula = "=iferror(VLOOKUP(C2,'path to xlsx'sheet,2,FALSE),'0'"
Range("Mini2:mini" & Cells(Rows.Count, "C").End(xlUp).Row).Formula = "=iferror(VLOOKUP(C2,'path to xlsx'sheet,2,FALSE),'0'"
'Split table into multiple workbooks
Dim ws As Worksheet
Dim var As Variant
Set ws = ActiveSheet
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
var = ws.Range("A2:F" & lastRow)
Dim i As Integer
For i = 2 To lastRow
If Not IsEmpty(Cells(i, 1)) Then
var(i - 1, 1) = Cells(i, 1).Value
If Not Dir("Walt_Disney_" & Cells(i, 1).Value & ".xlsx") = "" Then
Set newWB = Workbooks.Add
Set newWS = newWB.Sheets(1)
ws.Range("A" & i & ":F" & i).Copy Destination:=newWS.Range("A1")
newWB.SaveAs "Walt_Disney_" & Cells(i, 1).Value & ".xlsx"
newWB.Close
Else
Set newWB = Workbooks.Open("Walt_Disney_" & Cells(i, 1).Value & ".xlsx")
Set newWS = newWB.Sheets(1)


ws.Range("A" & i & ":F" & i).Copy Destination:=newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Offset(1, 0)
newWB.Save
newWB.Close
End If
End If
Next i
End Sub



Any help will be valuable!

Thanks in advance!

Attached Files

samplefile.xlsx (9.8 KB, 1 views)

Heeeeeeeeeelp

Is this assignment only to be done with VBA or can you explore Excel's Power Query to do most of the work?

If you aren't already familiar with Power Query you can start with some youtube videos

__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia

Yes, i am not familiar with PQ but i will give it a try.

This is a daily task. I 'm getting data from xml and i have to perform all these actions.
I thought that a vba code assigned to a button would be most user friendly.

Thanks for your time!