How to pull XML data into another excel sheet using VBA?

[paulked]

So in your comments you asked me to write the first part of the file name as it appears and I wrote the first 3 letters without the dash.

What I actually said was

Insert the first part of the file name here, exactly as it appears in the diectories, without the date.

(Oops! Missed an 'r' there!) That means EVERYTHING EXCEPT THE DATE.

Make a copy of that file you just tried and rename it "123 - AB 12345678 file - 03 Mar 2020.xlsm" to represent the exact file structure.
Don't delete any of the sheets themselves, but delete all the data off them (select top left corner to select all & press delete) then post it here. It works for me without fail, it must be something to do with he file. Syntax is absolute ruler in any code, and it can't be guessed!

[paulked]

The file can be like the attached, nothing complicated or confidential, just showing the structure and sheets. The name of this file is the inportant part

[paulked]

I changed the name of the above file to 123 - AB - 12345678 file - 22 Apr 2020.xlsm and moved it to the directory
C:\Users\Ahmed.Baksh\Desktop\NT\2020\Apr 2020\22 Apr 2020\

Then I changed the FILE NAME in D40 to "123 - AB - 12345678 file - " (note the space after the final dash)

Selected Week 3 (cell C45) and, Hey Presto!

Try it.

Put the 123 - AB file (attached) in the 22 Apr 2020 directory.

Open the 67421 file (attached) and then select Week 3 (cell C45) and you should get the same!

[StarBite207]

It may have worked for you but still not from my end

I have used your 67421 - WPU file but to really test it I have to put my directories location. Also, took note of the space after the dash for the original file name.
It shows that it is processing and it does open the file and then it ends up with (Error 9 occurred subscript out of range)

[paulked]

but to really test it I have to put my directories location.

Of course you do. Why haven't you set those up on whatever you are testing with?

67241c.jpg

[StarBite207]

I have that already on my laptop. I'm receiving the sheet you are sending and then logging the location of each file.
Directories are dynamic. They aren't fixed so VBA should open whatever the location I assign in these cells

[paulked]

The VBA will open the files in any directory specified, but because of constant inconsistancy it is better to do all the trials from fixed directories. Don't put the roof on the house until all the walls are built!

This will never work unless I have, or anyone else trying to sort this out has, the correct information.

From post #26

Each of the 6 directory locations has a common xlsm file name (Example; Ahmed – Daily File – Date.xlsm). But the date is not the same, so you have Ahmed – Daily File – 01 Apr 2020 and Ahmed – Daily File – 08 Apr 2020, etc .. (Side notes if they matter: the size of each file is 7 MB and all sheets are protected. All of the files are macro-enabled. These files have to be in different locations based on dated extractions for business purposes).

In each of these files, there is a common sheet named “2020”.

The samples provided have been nothing like the above, which is what the code is bases on and how it has been written.

The reason you are getting an error now is There is no sheet named 2020 in the file!

I'm out of tennis balls to bang over this net for tonight, I'll look tomorrow.

[paulked]

I've added more error handling in case someone with less knowledge of Excel is using it.

I've also added a Sheet Name cell (J40) so you can copy a different sheet if required (and cope with future years!).

In Sheet1(Master) module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim calc As Long
    With Application
        .ScreenUpdating = False
        If .Intersect(Target, Range("C42:C48")) Is Nothing Then Exit Sub
        calc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        If Target.Row <> 48 Then
            ImportXL Cells(Target.Row, "D"), Target.Value2, Range("J40")
        Else
            ImportAllXL
        End If
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Note: Application.ScreenUpdating does not need to be set to true on exit, Excel defaults to this after the routine is run.

In mdKed_Routines module:

Option Explicit

Sub ImportXL(fPath As String, wk As String, shName As String)
    On Error GoTo Oops
    Dim ex As String, str As String, sh As Worksheet, sht As Long, ct As Long
    'Check if Sheet Name has been entered
    If Range("J40") = "" Then MsgBox "No Sheet Name in J40!", vbCritical, "Please provide a sheet name...": Exit Sub
    'Check if File Name has been entered
    If Range("D40") = "" Then MsgBox "No File Name in D40!", vbCritical, "Please provide a file name...": Exit Sub
    'Check if file exists
    ex = fPath & "\" & Range("D40") & Right(fPath, 11) & ".xlsm"
    If Len(Dir(ex)) = 0 Then
        MsgBox "File:" & vbLf & ex & vbLf & "could not be found!", vbCritical, "No file available..."
        Exit Sub
    End If
    'Show progress
    frmWrk.lb1 = "Opening file..."
    frmWrk.lb2 = ex
    frmWrk.Show
    Application.StatusBar = "Copying " & ex & " data..."
    DoEvents
    'Open file
    Workbooks.Open fPath & "\" & Range("D40") & Right(fPath, 11) & ".xlsm", UpdateLinks:=0
    'Show progress
    frmWrk.lb1 = "Copying data from..."
    DoEvents
Eto1:
    'Copy Sheet
    If wk = "Start of the Month" Then
        ThisWorkbook.Sheets("Data SOM").Cells.ClearContents
        If ct = 0 Then ActiveWorkbook.Sheets(shName).Cells.Copy
        If ct > 0 Then ActiveWorkbook.Sheets(sht).Cells.Copy
        ThisWorkbook.Sheets("Data SOM").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        ThisWorkbook.Sheets("Data SOM").Range("A1").PasteSpecial Paste:=xlPasteFormats
    Else
        ThisWorkbook.Sheets("Data " & wk).Cells.ClearContents
        If ct = 0 Then ActiveWorkbook.Sheets(shName).Cells.Copy
        If ct > 0 Then ActiveWorkbook.Sheets(sht).Cells.Copy
        ThisWorkbook.Sheets("Data " & wk).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        ThisWorkbook.Sheets("Data " & wk).Range("A1").PasteSpecial Paste:=xlPasteFormats
    End If
    'Close file
    ActiveWorkbook.Close 0
NormXit:
    'Tidy up and exit
    ThisWorkbook.Sheets("Master").Activate
    Application.StatusBar = False
    Application.CutCopyMode = False
    frmWrk.Hide
    Exit Sub
Oops:
    'If error isn't Subscript out of Range, exit
    If Err.Number <> 9 Then MsgBox "Error " & Err.Number & " occurred." & vbLf _
        & Err.Description, vbCritical, "Oops! Error...": Exit Sub
    'Reset error
    On Error GoTo -1
    'Assume sheet not present for error 9
    'Build string of sheets
    ct = 1
    str = "You can choose another sheet by NUMBER." & vbLf & "If you don't want any to load, leave at zero." _
        & vbLf & "Sheets in this workbook:" & vbLf & vbLf
    For Each sh In ActiveWorkbook.Worksheets
        str = str & ct & ". " & sh.Name & vbLf
        ct = ct + 1
    Next
    str = str & vbLf & vbLf & "NUMBER of the spreadsheet to load (zero = Exit)."
Eto2:
    On Error GoTo Err2
    'Get alternative sheet
    sht = InputBox(str, "Sheet " & shName & " not found...", 0)
    'Check sheet number is valid
    If sht > ct Then
        MsgBox "Sheet doesn't exist!!!!", vbCritical, "Read the info..."
        GoTo Eto2
    End If
    'Exit as requested
    If sht = 0 Then GoTo NormXit
    'Try again
    GoTo Eto1
Err2:
    'Reset error
    On Error GoTo -1
    'String entered in inputbox
    MsgBox "It has to be a number!!!!", vbCritical, "Read the info..."
    GoTo Eto2
End Sub

Sub ImportAllXL()
    Dim i As Long
    For i = 42 To 47
        If Cells(i, 4) <> "" Then ImportXL Cells(i, 4), Cells(i, 3), Range("J40")
    Next
End Sub

[StarBite207]

And it works!!!
Also I loved the fact that if I failed to put the sheet name in J40, it populates a window for me to select the sheet (Tried copying any sheet other than the one I want and it worked) Found that pure excellence!
Last two questions to close this once and for all:
- I need to create a shape button for every week and assign the macro for it, the medked-routines vba is the one to be assigned for each button, correct?
- And if I want to to move the location of the entire range (C40:J48) somewhere in the same "Master" sheet just to re-organize and clean up, then I can just go to the same medked-routines vba and change the cells D40 and J40 to the pasted range, will this affect the vba in any way?
Thank you alot!!

[paulked]

The routines for the individual weeks are in modKed_Calls, but they need updating as I forgot to do it after adding the Sheet Name! I can't post a bas file here so replace the contents of the module with:

Option Explicit

Sub SoM()
    Dim calc As String
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        ImportXL Cells(42, 4), Cells(42, 3), Cells(40, 10)
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Sub Week1()
    Dim calc As String
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        ImportXL Cells(43, 4), Cells(43, 3), Cells(40, 10)
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Sub Week2()
    Dim calc As String
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        ImportXL Cells(44, 4), Cells(44, 3), Cells(40, 10)
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Sub Week3()
    Dim calc As String
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        ImportXL Cells(45, 4), Cells(45, 3), Cells(40, 10)
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Sub Week4()
    Dim calc As String
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        ImportXL Cells(46, 4), Cells(46, 3), Cells(40, 10)
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Sub Week5()
    Dim calc As String
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        ImportXL Cells(47, 4), Cells(47, 3), Cells(40, 10)
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

Sub AllWeeks()
    Dim calc As String, i As Long
    With Application
        calc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        For i = 42 To 47
            If Cells(i, 4) <> "" Then ImportXL Cells(i, 4), Cells(i, 3), Cells(40, 10)
        Next
        .DisplayAlerts = True
        .Calculation = calc
    End With
End Sub

The routine names are self-explanatory.

To move the range of cells used is not quite that simple. You need to replace every reference in the entire project with the new reference. Where cell references are made you need to change the row & column ref, unless a variable is used, and then change the range ref's.
In the above routines there are 43 changes to be made, 5 in the Master sheet module and 11 in the modKed_Routines module.

An alternative is to copy your new references to those cells that are referenced at present and then hide rows 40 - 48. so if you now want FILE NAME in J3, in cell D40 put the formula =J3 etc.

[StarBite207]

I have copied all the VBA in the modked_calls.
I will hide the cells and put "=" references without changing anything .. this is better and with no hassle

[paulked]

If you haven't already, don't forget to delete the old ones or you'll get an Ambiguous name error!

Excellent, you can mark this solved (thread tools top of page)

Take care and stay safe

[gary.reilly]

Certainly, I'd be happy to help you with that. Please try the following VBA code in your Excel macro-enabled workbook:

Sub ImportXMLData()
    Dim filePath As String
    Dim fileName As String
    Dim xmlDoc As Object
    Dim targetSheet As Worksheet
' Get the file path from the input sheet
    filePath = Sheets("Input").Range("B2").Value
' Check if the file path is empty
    If filePath = "" Then
        MsgBox "Please enter the file path in cell B2 of the Input sheet."
        Exit Sub
    End If
' Get the file name based on the designated naming convention
    fileName = "ACT H.xml" ' Change this if the naming convention is different
' Combine the file path and name
    filePath = filePath & Application.PathSeparator & fileName
' Check if the file exists
    If Dir(filePath) = "" Then
        MsgBox "The specified file does not exist."
        Exit Sub
    End If
' Set the target sheet to paste the data
    Set targetSheet = Sheets("ACT H")
' Open the XML file and copy the data
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.Load filePath
    xmlDoc.ChildNodes(0).Copy ' Copy the entire contents of the XML
' Paste the data into the target sheet
    targetSheet.Range("A1").PasteSpecial
' Close the XML file
    xmlDoc.Close
' Clean up
    Set xmlDoc = Nothing
    Set targetSheet = Nothing
' Inform the user about the completion
    MsgBox "XML data has been imported successfully."
End Sub

Here's how to add the code to your workbook:

1. Press Alt + F11 to open the VBA Editor in Excel.
2. In the VBA Editor, go to Insert and select Module insert a new module.
3. Copy and paste the code into the module.
4. Close the VBA Editor.

To attach the code to a button:

1. Go to the worksheet where you want to place the button (the sheet with the "input" sheet).
2. Go to the Developer tab (if you don't see it, you may need to enable it in Excel settings).
3. Click on Insert in the Controls group, and select a button shape.
4. Draw the button on the sheet.
5. In the Assign Macro a dialog box, select the ImportXMLData macro, and click OK.

[Aussiebear]

Hey Gary, why is it that you firstly corruptly reply with a non sensical post and then rebound to a reply to a very late thread. Are you seeking to be someone worthy of deletion or not?

[georgiboy]

Looks like a copy/ paste from ChatGPT to me. Below is what ChatGPT has to say about it:


If you are copying code directly from a conversation with ChatGPT, there are a few things to consider:


Ownership and Licensing: The code generated by ChatGPT is a product of the OpenAI language model and its underlying training data. It's important to understand that ChatGPT's responses are based on a mixture of licensed data, data created by human trainers, and publicly available data. Therefore, you should be mindful of any licensing restrictions or copyright issues that may apply to the code generated.


Attribution: Similar to copying code from forums, it is essential to give appropriate credit and attribution when using code from ChatGPT. You should acknowledge that the code was generated by an AI language model and provide a reference to the source, such as mentioning ChatGPT or OpenAI.


Understanding and Adaptation: While ChatGPT can provide code snippets or examples, it's important to thoroughly understand the code before using it. Carefully review the functionality, test it, and make any necessary adaptations to ensure it fits your specific requirements. Remember that ChatGPT's responses are based on the information available up to September 2021, and it may not be aware of recent updates or developments in programming languages or frameworks.


Quality and Reliability: Code generated by ChatGPT should be treated with caution, as it may not always provide optimal or bug-free solutions. It is advisable to verify the code's accuracy, test it extensively, and ensure it meets the necessary quality standards before using it in production environments.


In summary, if you copy code directly from ChatGPT, similar considerations apply as when copying from forums. Always provide proper attribution, understand the code's functionality, and ensure its quality and reliability before utilizing it in your projects.