How to fetch data from a excel table with multiple rows.

[bmba007]

Hi, I'm new to VBA and in programming in general & I have a excel workbook in which there are 2 sheets (sheet1 & sheet2).

In sheet1 there is a table with multi row header
1.jpg

In sheet2 I want to query data given in the below format:
2.png

Also, in sheet2 I want the output to be like:
3.jpg

For each query a new row will be added to the above table in sheet2 (range J:N). Note that in sheet1 MONTHLY SALARY & YEARLY SALARY appear twice one under NATIVE CURRENCY(USD) & other under FOREIGN CURRENCY(EURO). I have not found any data fetching technique for excel table with multiple header in any tutorial websites.How can I write the code to do what I just mentioned?

Also, attaching the file for testing.

[Paul_Hossler]

I did have to re-arrange your data a little

Option Explicit


Sub CopyFiltered()
    Dim wsData As Worksheet, wsOutput As Worksheet
    Dim rData As Range, rCrit As Range, rOutput As Range
    
    Set wsData = Worksheets("Sheet1")
    Set wsOutput = Worksheets("Sheet2")
    
    Set rData = wsData.Range("B3").CurrentRegion
    Set rCrit = wsData.Range("M3").CurrentRegion
    Set rOutput = rCrit.Cells(1, rCrit.Columns.Count + 2)
    
    wsOutput.Range("B3").CurrentRegion.EntireColumn.Delete
    wsData.Select
    rData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=rOutput, Unique:=False
        
    
    rOutput.CurrentRegion.Cut wsOutput.Range("B3")
    wsOutput.Range("B3").CurrentRegion.EntireColumn.AutoFit


    Application.CutCopyMode = False


End Sub

[bmba007]

Hi Paul, Can you explain your code with some comments in it. I'm new to VBA so it will be easier for me to understand.

Also, what is the reason for adding a extra blank row in the source?

Thanks

[Paul_Hossler]

'requires all variables to be explictly Dim-ed
Option Explicit


Sub CopyFiltered()
    Dim wsData As Worksheet, wsOutput As Worksheet
    Dim rData As Range, rCrit As Range, rOutput As Range
    
    'sets the worksheet object 'wsData' = the worksheet 'Sheet1'
    '   helps make things clearer in the code
    Set wsData = Worksheets("Sheet1")
    'same
    Set wsOutput = Worksheets("Sheet2")
    
    'set the rData range object = all the cells around B3 on wsData, or B3:J15
    '   that was one reason for the blank line
    '   the other was that I didn't want the criteria headers to be confused
    '   just seemed cleaner to me
    Set rData = wsData.Range("B3").CurrentRegion
    'same = M3:N5
    Set rCrit = wsData.Range("M3").CurrentRegion
    
    'I used .CurrentRegion so that if more lines are added to data or the criteria changes, the changes
    '   will be automatically picked up
    
    'Advanced Filter requires destination to be on same page so
    '   this is the same as the first row in rCrit, but 2 columns past the last column (blank area)
    Set rOutput = rCrit.Cells(1, rCrit.Columns.Count + 2)
    
    'deletes the entire column for all cells in the block around B3 on the final destination sheet
    wsOutput.Range("B3").CurrentRegion.EntireColumn.Delete
    wsData.Select
    
    'filters the rData using the critera in rCrit and put the result (still on wsData) in the output location
    rData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=rOutput, Unique:=False
        
    'cuts the wsData output region and puts it on the wsOutPut sheet
    rOutput.CurrentRegion.Cut wsOutput.Range("B3")
    
    'autofits the column widths of the output region on wsOutput
    wsOutput.Range("B3").CurrentRegion.EntireColumn.AutoFit


    Application.CutCopyMode = False


End Sub

[bmba007]

Thanks Paul, for the explanation. BTW, your code automatically sorts the result data by SL. NO. How do I stop that?

[Paul_Hossler]

1. No problem

2. To stop it sorting by SL. NO, don't put the data in sorted by SL. NO.

Capture.JPG

The output is in the same order as the input

How would you like it sorted?

[paulked]

@Paul

I'm sure it's been mentioned before, but those added 'graphics'... superb

[bmba007]

I want it to be sorted by the query value i.e. if I first run with say JIM ACNIO and then RICK BELE, then first the values related to JIM ACNIO will be displayed and then of RICK BELE. I've already posted my desired output in the 1st post of my question. Also I do not want to fetch all column data just specific ones.

Go through my question again for better understanding

[paulked]

[Paul_Hossler]

I want it to be sorted by the query value i.e. if I first run with say JIM ACNIO and then RICK BELE, then first the values related to JIM ACNIO will be displayed and then of RICK BELE. I've already posted my desired output in the 1st post of my question. Also I do not want to fetch all column data just specific ones.

Go through my question again for better understanding

Sorry - would you like a refund?


Advanced Data Filter with Criteria gets confused if the column headers are not unique so I had to add "(USD)" and "(EURO)"

Option Explicit


Sub CopyFiltered()
    Dim wsData As Worksheet, wsOutput As Worksheet
    Dim rData As Range, rCrit As Range, rOutput As Range
    Dim vSort As Variant
    
    Set wsData = Worksheets("Sheet1")
    Set wsOutput = Worksheets("Sheet2")
    
    Set rData = wsData.Range("B3").CurrentRegion
    Set rCrit = wsData.Range("M3").CurrentRegion
    Set rOutput = rCrit.Cells(1, rCrit.Columns.Count + 2)
    
    wsOutput.Range("J3").CurrentRegion.EntireColumn.Delete
    wsData.Select
    rData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=rOutput, Unique:=False
        
    vSort = Application.WorksheetFunction.Transpose(rCrit.Cells(2, 1).Resize(rCrit.Rows.Count - 1, 1).Value)
        
    
    Application.AddCustomList ListArray:=vSort


    wsData.Sort.SortFields.Clear


    'sort on custom order with header
    rOutput.Cells.Sort Key1:=rOutput.Columns(2), Order1:=xlAscending, _
                Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, _
                OrderCustom:=Application.CustomListCount + 1


    wsData.Sort.SortFields.Clear
    
    Application.DeleteCustomList Application.CustomListCount
    
    With wsOutput
        rOutput.CurrentRegion.Cut .Range("I3")
    
        .Columns("I:I").Clear
        .Columns("K:K").Cut .Columns("R:R")
        .Columns("K:K").Delete Shift:=xlToLeft
        .Range("L3").Value = "SALARY (USD)"
        .Columns("M:M").Delete Shift:=xlToLeft
        .Columns("M:M").Delete Shift:=xlToLeft
        .Range("M3").Value = "SALARY P.A. (EURO)"
        .Columns("N:N").Delete Shift:=xlToLeft
        .Columns("N:N").NumberFormat = "dd mmmm yyyy"
        
        .Range("J3").CurrentRegion.EntireColumn.AutoFit
    End With




    Application.CutCopyMode = False


End Sub

[bmba007]

I'm okay with a little help, no refund required

Thanks for the help.

[SamT]

I'm new to VBA and in programming in general

First, you must define all the Features

1. If the EW Score is changed on sheet2, refresh all names in the "Query" (name) Column to the Results table
2. If a name is added to the bottom of the "Query" column, Add the results of that name to the bottom of the results table
3. If a Row is Inserted into the "Query" Column, do nothing
   
   • If a name is added to that inserted Cell, Refresh all names to the Results table
   
   
4. If a change is made to the Data Table on Sheet1, check the "Query" column and EW Score on sheet 2 and refresh names in the results table as indicated
5. The Pasting of multiple names at the same time into the "Query" Column is allowed.

Coder Notes: The subs to handle all those features can be triggered by various WorkSheet Event subs
Coder Notes: Refresh All requires the Results table be cleared

Since you will be the IT person to maintain this workbook, I recommend that you first change the CodeNames of Sheet1 and Sheet2 to "Data" and "Results" respectively. This both makes your code simpler and prevents $Users from breaking your code by changing a Tab Name.

Since there is little comparison between the two sheets, it is best IMO, to fully describe each sheet in code. This will make the actual coding very easy to write, understand, and maintain.

I have started the code setup and put some hints in this attachment. I suggest that you try to complete the code setup, then we can check it and start the actual coding. Once the descriptive setup is done, the actual coding is simple and fast.

Note: Data is fully described, Don't change it. Use it as a pattern for describing Results.