How to exclude columns by name when importing multiple xml-files to Excel with VBA?

Question

I have managed to make a macro which imports multiple xml-files to excel, in individual tables. The problem is that some of the tables includes one extra column. I want the column names to be in the same column for all tables.

I am using VBA and I do not have that much experience with this.

Sub CommandButton1_Click()

    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xCount = 1
    xFile = Dir(xStrPath & "\*.xml")
    Do While xFile <> ""
        Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
        xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(xCount, 1)
        xWb.Close False
        xCount = xSWb.Sheets(1).UsedRange.Rows.Count + 2
        xFile = Dir()
    Loop
    Application.ScreenUpdating = True
    xSWb.Save

On Error Resume Next
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    Exit Sub


ErrHandler:
    MsgBox "no files xml", , "Kutools for Excel"

End Sub

How do you identify the extra column? Does it have the same caption? Is it at a fixed position? — FunThomas, Jul 04 '19 at 13:50
I need to identify it by column name. The position is not fixed since the additional column for one of the xml-files showed up in the middle of the table in excel. — Jan, Jul 04 '19 at 13:53
In addition, I the output shows headers in row 1 for the first xml-file. Further, I get headers for the second xml-file underneath without any space between the tables. For example: table for xml1 has headers in row 1 and data from r2 to r5. the table for xml2 has headers in row 6 and data from r7 to r11, etc.. — Jan, Jul 04 '19 at 14:05

score 1 · Answer 1 · answered Jul 04 '19 at 14:26

1

I would suggest you delete the extra column in the source sheet before you copy the data. As you close the file after the copy without saving, it shouldn't be a problem.

Note that when you delete something, you should always do it from the end to the start.

Dim startRow As Long
startRow = 1
xFile = Dir(xStrPath & "\*.xml")
Do While xFile <> ""
    Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
    With xWb.Sheets(1)
        Dim lastCol As Long, col As Long
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        ' Loop over all columns from right to left 
        For col = lastCol To 1 Step -1
            ' Throw the extra column away
            If .Cells(1, col) = "YourUnwantedCol" Then
                .Cells(1, col).EntireColumn.Delete
            End If
        Next col

        ' Now copy the data 
        .UsedRange.Copy xSWb.Sheets(1).Cells(startRow, 1)
        startRow = startRow + .UsedRange.Rows.Count
        ' Close without saving, don't show a warning.
        Application.DisplayAlerts = False
        xWb.Close False
        Application.DisplayAlerts = True

        xFile = Dir()
    End With
Loop

answered Jul 04 '19 at 14:26

FunThomas

23,043
3
18
34

Helpful & easy +1) - FYI another approach to flexibilize target columns - [moving columns based on header name](https://stackoverflow.com/questions/52822542/moving-columns-based-on-header-name/56778630#56778630) - @FunThomas – T.M. Jul 04 '19 at 15:10
1

Was thinking about something like that, but preferred to loop over all columns as this makes it easier to adapt when the logic how to identify the unwanted column(s) changes. – FunThomas Jul 04 '19 at 15:13
The logic in the cited answer identifies the *wanted* columns, so you get no problem with any *unwanted* one. - @FunThomas BTW You wrote a perfect & clever answer, in any case for less experienced users. – T.M. Jul 04 '19 at 15:43
Thank you Thomas. I will try this out now. But how should I link this to my current code? – Jan Jul 05 '19 at 07:49
I need to delete this column for every xml-file I am importing. So I am guessing I need to implement it in my current loop? – Jan Jul 05 '19 at 07:53
Yes. Look at my code: It contains already the loop. Just C&P it to replace your `Do While`-Loop – FunThomas Jul 05 '19 at 08:36
hmm, I get the same output as before. – Jan Jul 05 '19 at 10:51
Debug your code and check why the column is not removed. Have you adapted the name of the column you want to delete? – FunThomas Jul 05 '19 at 11:01
Yup, I have adapted the name of the column. I used the exact name I got from the output. Check my answer below with the updated code. – Jan Jul 05 '19 at 11:09
Sorry, I cannot help you any further with this. As I said, debug the code and check why the column is not removed. – FunThomas Jul 05 '19 at 11:19

score 0 · Answer 2 · answered Jul 05 '19 at 11:06

Sub CommandButton2_Click()

Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xCount = 1
    xFile = Dir(xStrPath & "\*.xml")



    Dim startRow As Long
startRow = 1
xFile = Dir(xStrPath & "\*.xml")
Do While xFile <> ""
    Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
    With xWb.Sheets(1)
        Dim lastCol As Long, col As Long
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        ' Loop over all columns from right to left
        For col = lastCol To 1 Step -1
            ' Throw the extra column away
            If .Cells(1, col) = "Content" Then
                .Cells(1, col).EntireColumn.Delete
            End If
        Next col

        ' Now copy the data
        .UsedRange.Copy xSWb.Sheets(1).Cells(startRow, 1)
        startRow = startRow + .UsedRange.Rows.Count
        ' Close without saving, don't show a warning.
        Application.DisplayAlerts = False
        xWb.Close False
        Application.DisplayAlerts = True

        xFile = Dir()
    End With
Loop

    Application.ScreenUpdating = True
    xSWb.Save

'Removes rows with no "event id"
On Error Resume Next
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Exit Sub


ErrHandler:
    MsgBox "no files xml", , "Kutools for Excel"

End Sub

How to exclude columns by name when importing multiple xml-files to Excel with VBA?

2 Answers2