Thread: Name defining based on XML input

Hi

How about using an advanced filter that will bring in the ones you want to a consistent place. You then work on your consistent place.

If there is a required column missing, then it would pay to pre check your data and issue a warning message if the column was missing.

rylo

Originally Posted by rylo

Hi

How about using an advanced filter that will bring in the ones you want to a consistent place. You then work on your consistent place.

If there is a required column missing, then it would pay to pre check your data and issue a warning message if the column was missing.

rylo

What do you mean by advanced filter to import colums? That is basically what I am trying to acheive with named ranges? Do you have a refernce or link that you have used before to design an advanced import filter so I could read up on it sounds like something I would want to use.

Been Searching around on the advanced filter and VBA. I found the below code, the concept of the advanced filter seems correct however I do note that in the code example below he defines the columns to bring across by cell reference. If the contents of the cell reference changes then the macro fails, that is what I need to circumvent. Any ideas?

Sub UniqueCustomerProduct()
   
    Dim IRange As Range
    Dim ORange As Range
    
    Worksheets("SalesReport").Select
    Range("J1:AZ1").EntireColumn.Delete
    
    ' Find the size of today's dataset
    FinalRow = Cells(65536, 1).End(xlUp).Row
    NextCol = Cells(1, 255).End(xlToLeft).Column + 2
    
    ' Set up output range. Copy heading from D1 there
    Range("D1").Copy Destination:=Cells(1, NextCol)
    Range("B1").Copy Destination:=Cells(1, NextCol + 1)
    Set ORange = Cells(1, NextCol).Resize(1, 2)
    
    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
    
    ' Do the Advanced Filter to get unique list of customers & product
    IRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ORange, Unique:=True
        
    ' Determine how many unique rows we have
    LastRow = Cells(65536, NextCol).End(xlUp).Row
    
    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 2).Sort Key1:=Cells(1, NextCol), Order1:=xlAscending, Key2:=Cells(1, NextCol + 1), Order2:=xlAscending, Header:=xlYes
    
End Sub

Hi

Create and attach an example file that shows your general structure, and where things should go. Make it generic enough that it will cover your real situation. I'm sure we can come up with some code to suit.

rylo

I have attached an excel spreadsheet which is how it opens up from my xml import. I have highlighted in orange the columns I keep. You will notice columns with data such as

1-2-4-5 $20

, they are important columns and I have a macro which splits them into 4 more columns so that each number and dollar have there own column.

I just need a consistent column set so macro works.

Its late night here, I will actually ge a good opportunity to do a lot of work on this tommorrow if anyone has a good idea on te import function to ad flexibility to XML I would realy appreciate it.

Hi

In sheet2 range A1:AA1enter the list of headings you want to extract.

Then run

Sub aaa()
  With Sheets("Sheet1")
    .Range("A1").CurrentRegion.AdvancedFilter copytorange:=Sheets("Sheet2").Range("A1:aa1"), action:=xlFilterCopy
  End With
End Sub

rylo

Originally Posted by rylo

Hi

In sheet2 range A1:AA1enter the list of headings you want to extract.

Then run

Sub aaa()
  With Sheets("Sheet1")
    .Range("A1").CurrentRegion.AdvancedFilter copytorange:=Sheets("Sheet2").Range("A1:aa1"), action:=xlFilterCopy
  End With
End Sub

rylo

Thanks for the help! Would i need to do that Manually everytime or can I create that as a macro before the advanced filter?

I am getting an error "the extract range has a missing or illegal field name" for the .Range("A1") of the advanced filter. This is the code I adapted to yours to automate the process.

Sub InsertColumnHeadingSheet2()
'
' InsertColumnHeadingSheet2 Macro
'

'
    Workbooks.Add
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Datasheet"
    Range("A1") = "venue"
    Range("B1") = "date"
    Range("C1") = "rail"
    Range("D1") = "name"
    Range("E1") = "mediumname"
    Range("F1") = "distance"
    Range("G1") = "age"
    Range("H1") = "weightcondition"
    Range("I1") = "totalprize"
    Range("J1") = "first"
    Range("K1") = "second"
    Range("L1") = "third"
    Range("M1") = "saddlecloth"
    Range("N1") = "horse"
    Range("O1") = "id5"
    Range("P1") = "barrier "
    Range("Q1") = "weight"
    Range("R1") = "rating"
    Range("S1") = "description"
    Range("T1") = "age6"
    Range("U1") = "career"
    Range("V1") = "goodtrack"
    Range("W1") = "deadtrack"
    Range("X1") = "slowtrack"
    Range("Y1") = "firstup"
    Range("Z1") = "secondup"
    Range("AA1") = "thistrack"
    Range("AB1") = "thisdistance"
    
    Dim SaveDate As String
    Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xml*), *.xml*", Title:="Choose File To Copy", MultiSelect:=False)
    If Filename = "False" Then Exit Sub
    ActiveWorkbook.XmlImport URL:=Dir(Filename), ImportMap:=Nothing, Overwrite:=True, Destination:=Worksheets("sheet1").Range("$A$1")
    MsgBox "You selected " & Dir(Filename)
    
    With Sheets("Sheet1")
    .Range("A1").CurrentRegion.AdvancedFilter copytorange:=Sheets("Datasheet").Range("A1:ab1"), Action:=xlFilterCopy
    End With
    
    ' Ammending date in first row to display dd-mm-yyyy
    DateAmmend = Worksheets("Datasheet").Cells(Rows.Count, 1).End(xlUp).Row
    For k = 2 To DateAmmend
        If Cells(k, 2).Value > 0 Then
        Cells(k, 2).NumberFormat = "[$-C09]dd-mmmm-yyyy;@"
        End If
    Next k
    LastRow3 = Range("B" & Rows.Count).End(xlUp).Row
    Range("B2:B" & LastRow3).NumberFormat = "[$-C09]dd-mmmm-yyyy;@"
    
    SaveDate = (Worksheets("Datasheet").Range("A2").Value & Worksheets("Sheet1").Range("B2").Text)
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Family\My Documents\Racing" & SaveDate & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
End Sub

Hi

Have you made sure that all the headings are actually in the source data sheet, and that the spelling is exactly the same? No extra spaces in the original data perhaps?

rylo

wow found one space in one word and that was gumming up the works.