PDA

View Full Version : [SOLVED] How to pull XML data into another excel sheet using VBA?



StarBite207
04-27-2020, 02:11 PM
Hi all,

I hope you can help me on this as26458 I'm searching online for a solution to the below:

I have a excel macro-enabled workbook that I want "any user" to be able to use on their desktop. This workbook can be saved on any location on the user's PC. It requires "XML" files extractions to pull in the data from.

The workbook has an "input" sheet where the user can place the file location of the xml files. The xml files will be having designated names (Example: ACT H.xml).

The button that I want the VBA to be attached to should perform the below VBA action:

1- Locate the xml file with the designated name in the location specified by the user in the main input sheet.
2- Open the xml file, copy entirely everything and paste the data in the active main excel sheet in the designated sheet "ACT H".
3- The xml file to automatically close.

I have attached the image for your reference.

Really appreciate your input as I have been trying some codes online but with no luck!

paulked
04-27-2020, 10:06 PM
Hi and welcome to the forum.

If all you want to do is steps 1 to 3 then this:



Sub ImportActH()
Workbooks.Open Sheets("input").Range("e4") & "act h.xml"
Sheets("act h").Cells.Copy ThisWorkbook.Sheets("act h").Range("a1")
ActiveWorkbook.Close 0
End Sub


To clear Act H sheet 1st then:



Sub ImportActH()
Sheets("act h").Cells.ClearContents
Workbooks.Open Sheets("input").Range("e4") & "act h.xml"
Sheets("act h").Cells.Copy ThisWorkbook.Sheets("act h").Range("a1")
ActiveWorkbook.Close 0
End Sub


To chose a file from the directory specified in E2 and copy it to the relevant sheet (creating the sheet if it doesn't exist):



Sub ImportXML()
Dim fXml, fName As String, sh As Worksheet, arr
ChDir Sheets("input").Range("e2")
fXml = Application.GetOpenFilename("XML Files (*.xml),*.xml*", 1, "Select XML File", "Open", False)
If TypeName(fXml) = "Boolean" Then Exit Sub
Workbooks.Open fXml
arr = Split(fXml, "\")
fName = Left(arr(UBound(arr)), Len(arr(UBound(arr))) - 4)
With ThisWorkbook
On Error Resume Next
Set sh = .Sheets(fName)
On Error GoTo 0
If sh Is Nothing Then .Sheets.Add(After:=.Sheets("input")).Name = fName
.Sheets(fName).Cells.ClearContents
Sheets(fName).Cells.Copy .Sheets(fName).Range("a1")
End With
ActiveWorkbook.Close 0
End Sub


PS You need to add a final backslash to your file locations (C:\Users\...\OTB Report\) etc

StarBite207
04-28-2020, 12:10 PM
Thanks a lot. That really did the job swiftly! :)

I chose to work with your second vba option. I would need to do the same for the "BOB" xml file. Would it work if I only replace the file name in the code to "BOB" instead of "act h"?

Also, on the second try, I got the below error message. I neither changed the location of the file nordid not rename it. Not sure why?

26472

To understand better the third vba, it is a generic vba to allocate any "xml" files from the directory specified by the user regardless of the xml file's name, correct? Can this be used to open any excel file format?

paulked
04-28-2020, 12:27 PM
Code for Bob H:



Sub ImportBobH()
Sheets("bob h").Cells.ClearContents
Workbooks.Open Sheets("input").Range("e5") & "bob h.xml"
Sheets("bob h").Cells.Copy ThisWorkbook.Sheets("bob h").Range("a1")
ActiveWorkbook.Close 0
End Sub


I can't see the error you got (invalid attachment) but you shouldn't get an error.

Yes, any XML, not any other format (without changes!)

StarBite207
04-28-2020, 12:50 PM
There it is:
26476

Run-time error '1004':
Sorry, we couldn't find C:\Users\Ahmed.Baksh\Desktop\NT\Up-Graded Tools\OTB Report\ACT Hact h.xml. Is it possible it was moved, renamed or deleted?

paulked
04-28-2020, 01:25 PM
From post #2


PS You need to add a final backslash to your file locations (C:\Users\...\OTB Report\) etc

It looks as if you haven't done that!

StarBite207
04-28-2020, 01:43 PM
It is there already in the E4 cell and when I tried it the first time, it worked : pray2:

I remember now one thing, when I tried your third vba I changed the name temporarily just to check how it goes. Then, I changed it back to its original name "ACT H" - do you think this affected the code?

paulked
04-28-2020, 01:59 PM
Run-time error '1004':
Sorry, we couldn't find C:\Users\Ahmed.Baksh\Desktop\NT\Up-Graded Tools\OTB Report\ACT Hact h.xml. Is it possible it was moved, renamed or deleted?

Where is the backslash between \ACT H and act h.xml? It should be the last character in E4. Find it and you'll solve the problem.

If you can't, post your workbook.

paulked
04-28-2020, 02:21 PM
To post your workbook select Go Advanced then select Attachments.

26477
26478

StarBite207
04-28-2020, 02:34 PM
Here we go ...

Also, see this screenshot for your reference:

26480

paulked
04-28-2020, 02:49 PM
Your concat's needed another backslash in them.

StarBite207
04-28-2020, 03:09 PM
I'm terribly sorry I'm troubling you in this, but it is still not working :crying:

I tried to attach my XML files so that you can try from your end, but can't send them over here.

I have noticed that it is only working when I'm removing the value in "D4", then the code works and pulls the data.

I believe because the vba code already is defining the file name as "act h.xml" whereas the "ACT H" path value does not exist.

Mean to say, the "ACT H.xml" is located in the last folder "OTB" and there is no folder called "ACT H".

Really hope you can have a last try on this : pray2:

paulked
04-28-2020, 03:31 PM
That's the problem!Why have you got E4 & E5? They are superfluous and confusing! It's a problem that always crops up when mixing sheet logic and code logic. In my opinion don't!

VBA code ignores E4 & E5 and changes to this (keep E2 the same as in your last screenshot)



Sub ImportActH()
Sheets("act h").Cells.ClearContents
Workbooks.Open Sheets("input").Range("e2") & "\act h.xml"
Sheets("act h").Cells.Copy ThisWorkbook.Sheets("act h").Range("a1")
ActiveWorkbook.Close 0
End Sub

Sub ImportBobH()
Sheets("bob h").Cells.ClearContents
Workbooks.Open Sheets("input").Range("e2") & "\bob h.xml"
Sheets("bob h").Cells.Copy ThisWorkbook.Sheets("bob h").Range("a1")
ActiveWorkbook.Close 0
End Sub

StarBite207
04-28-2020, 03:40 PM
Thanks a lot! It works now :whistle:

Can I put these two codes in one vba? and if one file is missing will the other one works?
Example, "ACT H.xml" exists in the directory and "BOB H.xml" isn't, can it perform one action?

paulked
04-28-2020, 03:41 PM
If this is to work on any computer then I would suggest that the same directory is set up on each machine. eg C:\Upgraded tools\OTB Report\

That way there is no need for any user intervention once you've set them up. :thumb

paulked
04-28-2020, 03:43 PM
Thanks a lot! It works now :whistle:

Can I put these two codes in one vba? and if one file is missing will the other one works?
Example, "ACT H.xml" exists in the directory and "BOB H.xml" isn't, can it perform one action?

Sure. Which one has priority? eg look for Act 1st then Bob?

StarBite207
04-28-2020, 03:49 PM
The problem is, every team member of mine uses different directory/location.
If one assigns his own directory location and paste it in E2 given that all files are grouped in the same directory location, it should work, correct?

paulked
04-28-2020, 03:55 PM
In theory, correct. But why do they have to use a different directory? Surely if everyones is the same it's easier to set up and maintain.

StarBite207
04-28-2020, 04:04 PM
Understood. But due to some filing protocols in the company, they would eventually need to. Example, I'm using this file on my laptop with a specific directory and they are using it with a different directory.

On a different note, can this code be used to extract excel file instead of .xml (such as .xls etc..) Can I tweak it? And can it be done for the third VBA you suggested - as it's most interesting :clap:

paulked
04-28-2020, 04:33 PM
Sub OpenAnyXL()
Dim fName As String
fName = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", 1, "Select Excel File", "Open", False)
If fName = False Then Exit Sub
Workbooks.Open fName
End Sub

paulked
04-29-2020, 01:38 AM
I've had a sleep now!

You could limit the file open to compatible files, eg xml, csv or xl as in this example:



Sub ImportFile()
Dim fName As Variant, fType As String, fPath As String
fPath = Sheets("input").Range("e2").Text
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
TryAgain:
ChDir fPath
fName = Application.GetOpenFilename("Compatible Files *.xml *.csv *.xl*,*.xml;*.xl*;*.csv", 1, "Select a File to Import...")
If fName = False Then GoTo Xit
If LCase(Left(fName, Len(fPath))) <> LCase(fPath) Then
If MsgBox("You cannot load a file from this directory. Try again?", vbYesNo, "Wrong folder...") <> vbYes Then Exit Sub
GoTo TryAgain
End If
fType = Right(fName, 3)
If fType = LCase("xml") Or fType = LCase("csv") Then
MsgBox "XML or CSV files can be imported direct to the workbook"
Else
MsgBox "Excel Files can be opened to manually copy data from or certain sheets/data copied from them via VBA"
End If
Exit Sub
Xit:
MsgBox "No file loaded.", , "Cancelled?"
End Sub

This restricts files to XML, CSV or XL* and also to the directory or its sub directories in E2.

StarBite207
04-29-2020, 11:01 AM
Tried using this VBA. It opens the directory specified but can't import any file.
When opening xml file, the message displays (xml or csv file can be imported direct to workbook)
and when trying Excel file it says (Excel files can be opened to manually copy data from or certain sheets/data copied from them via VBA)

paulked
04-29-2020, 11:09 AM
Yes, because it's an example!

I have no idea what to do if it's an Excel file you are opening and don't know what other formats you use, or may use (csv for instance).

StarBite207
04-29-2020, 11:32 AM
ok but how can i make this vba example work if say I want to open .xlsx file? Sorry, it's complicated for me to understand.

also a question for vba 2, does it work if i changed the file extension from .xml to .xlsx if i the file extension is already xlsx? or does it only work for .xml?

example:


Sub ImportBobH()
Sheets("bob h").Cells.ClearContents
Workbooks.Open Sheets("input").Range("e2") & "\bob h.xml" --> Instead of bob h.xml to bob h.xlsx?
Sheets("bob h").Cells.Copy ThisWorkbook.Sheets("bob h").Range("a1")
ActiveWorkbook.Close 0
End Sub

paulked
04-29-2020, 11:53 AM
When you open an Excel file it can have more than one sheet.

What sheet would you like it to copy and to where? What if the sheet doesn't exist in the a) the newly opened workbook and b) the 'import' workbook? What if the sheet data is older than what you've already got? How do you tell if it is older? Do you want to load from any directory?

These are questions that have to be answered before starting, and maybe a few more! It can all be done in VBA, but not 'on the fly'.

I posted the example because you were interested. If you want to go ahead I'm willing to help, but only once you have a clear idea what goal you want to acheive :thumb

StarBite207
04-30-2020, 01:17 PM
Ok .. so I have another macro-enabled excel workbook.

Sheet “Master” is where I will allocate 6 files locations as shown in the screenshot.

26509

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”.

I want two vba codes:



First VBA assigned to each directory: The vba code to go the designated location, automatically opens and select that specific file name, copy sheet “2020” and paste it all in the data sheet specified for it (Example, Week 1 directory to load in Data Week 1) and then closes the file automatically. Off course, I want the destination sheet to be cleared first.
Second VBA: A Master vba code that runs the same action as the first one but for all directories one by one.



Also when pasting, I want it to paste values and format of the origin source but no formulas at all.

Due to above nature of the actions I want to do, I’m ok with the third vba you proposed that populates a window for me to select the files. But, if there’s a different one that does all the above without me selecting files – if possible, that would be great.

paulked
04-30-2020, 03:24 PM
It would be a great help if you could post your workbook and a workbook you are pulling data from :*)

StarBite207
04-30-2020, 05:27 PM
The thing is the reports are work related and confidential .. is there a way to work this around?

paulked
04-30-2020, 05:40 PM
You could strip out the confidential data and just leave the structure there. It really would save some guessing my end!

paulked
04-30-2020, 07:59 PM
To save me going down the wrong route, I could do with knowing a few things.

1. Are you happy with initiating each macro by selecting a cell? My thoughts are selecting Week 1 (C41) would copy that weeks data to Data Week 1 Sheet and so on. To copy all weeks, select cell C46 (We can put "All Weeks" in there)
2. You say the sheets are protected, if they are password protected I'll need the password, or you enter it in run-time.
3. Is there only one XLSM file in each directory that ends with the date? (eg Ahmed – Daily File – 01 Apr 2020.xlsm)
4. What happens when Start Of Month equals the 1st day of week 1?
5. The name (eg Ahmed) has to be picked up from somewhere, can we have that in a cell?

Again, a sample of the structure of one of the 2020 sheets would be really helpful. It can contain nonsense... as long as the nonsense is in the right cells!

StarBite207
05-01-2020, 12:14 PM
To answer your questions first:

1. Are you happy with initiating each macro by selecting a cell? My thoughts are selecting Week 1 (C41) would copy that weeks data to Data Week 1 Sheet and so on. To copy all weeks, select cell C46 (We can put "All Weeks" in there)

- I'm fine with this suggestion. Separate VBAs per each will work and I will assign the buttons per each.

2. You say the sheets are protected, if they are password protected I'll need the password, or you enter it in run-time.

- The password is only there to restrict the user from amending the sheet. It opens up normally with no password required to access.

3. Is there only one XLSM file in each directory that ends with the date? (eg Ahmed – Daily File – 01 Apr 2020.xlsm)

- The way I file, yes. One xlsm sheet with a particular name in that location. For the sake of giving here the example, had to put the file name out at such. In reality, it is (Hotel Name - xxx file name - Date.xlsm).

4. What happens when Start Of Month equals the 1st day of week 1?

- Didn't really understand that. But the start of the month is surely the extraction of the of the 1st might be the 2nd depends on a business calendar, then post that date up to 7 days would be considered the first week of the month. Anyhow, I segregate these files into different folders.

5. The name (eg Ahmed) has to be picked up from somewhere, can we have that in a cell?

Sure, I have added it up.

So here's the file. I replicated the original version of "2020".

26532

And here's my file where I need all my imports to land:

26533

Taken some time to reformat and adjust before attaching

paulked
05-01-2020, 01:04 PM
Thanks. Will hget stuck into it in the morning :thumb

paulked
05-02-2020, 08:58 AM
Well, I think we're there! Try it out and let me know (I have put some notes on the master sheet).

StarBite207
05-02-2020, 10:55 AM
See the file name I gave out was an example "Daily File" as I said before.
So, I changed the file name to the actual name without (dots, / or -) in cell D42.
Then I went to the VBA and adjusted where you mentioned " - Daily File - " to the original unified file name between the two dashes exactly (Nothing else was adjusted in any of the provided VBA.
26552
It gave out the message "There isn't a valid file in the directory!"

3. The Test 9 file you sent me was an xlsx rather than a macro enabled file: I've allowed the code to open either, but it gives priority to xlsm files if both types are there --> Because I had to replicate the original file. Also, there is only one .xlsm file in the directory/else I can make sure that one .xlsm file is present in that directory when I'm running the report.

1. In modKed_Months there is a series of code that does the same as all your modules 1-10 --> Unfortunately, I couldn't try and see this feature because I had to delete the sheets in the original WPU Monitor sheet before up-loading. Can't up-load more than 1 MB here!

paulked
05-02-2020, 11:09 AM
I don't completely understand what you are saying. Are you saying that:


Each of the 6 directory locations has a common xlsm file name (Example; Ahmed – Daily File – Date.xlsm).

is not a file named Ahmed - Daily File - Date.xlsm but something else?

StarBite207
05-02-2020, 11:16 AM
The common name of the file is Hotel Name - xxx file - Date.xlsm (I just can't publicly put out the name here).
All these 6 directories have that file name. The only difference, the date is different.
I gave the name Ahmed - Daily File - Date.xlsm for the sake of an example here.

paulked
05-02-2020, 11:29 AM
That would have been nice to know, even if secret you could have said *variable* or something. I'm enjoying a glass or two of wine now with the wife, will have a look asap.

StarBite207
05-02-2020, 11:34 AM
Thanks a lot. Take your time, I'm not in a hurry :thumb

paulked
05-02-2020, 03:43 PM
Try this one, notes in the file. I created directories to match yours and have run the routines successfully, I hope you have the same results :thumb

26557

StarBite207
05-03-2020, 09:26 AM
Ok I tried it and we are almost there, but it didn't work.
First, the file name is *** - ** ******** file - 03 Mar 2020
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. It gave out the message (There isn't a valid file in that directory!). I also tried it with a dash (*** -) also gave the same message.
Then I tried putting the entire file name without the date in the end like this (*** - ** ******** file -). And it worked in showing a message that is processing, the file in that directory was opened, then an error message appears (error 9 occurred. subscript out of range).
What seems to be the challenge?

paulked
05-03-2020, 09:50 AM
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
05-03-2020, 11:42 AM
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 :thumb

paulked
05-03-2020, 12:42 PM
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
05-03-2020, 12:56 PM
It may have worked for you but still not from my end :crying:

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) :banghead:

paulked
05-03-2020, 01:02 PM
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?

26567

StarBite207
05-03-2020, 01:14 PM
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
05-03-2020, 01:41 PM
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
05-04-2020, 04:14 AM
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
05-04-2020, 03:43 PM
And it works!!! :bow::clap:
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
05-04-2020, 04:56 PM
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
05-05-2020, 02:05 AM
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 :thumb

paulked
05-05-2020, 02:18 AM
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 :thumb

gary.reilly
06-23-2023, 05:29 AM
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:


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

To attach the code to a button:


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

Aussiebear
06-23-2023, 06:04 AM
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
06-23-2023, 07:13 AM
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.