[SOLVED:] How to fetch data from a excel table with multiple rows.

4 Attachment(s)

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

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
Attachment 25457

In sheet2 I want to query data given in the below format:
Attachment 25458

Also, in sheet2 I want the output to be like:
Attachment 25459

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.

1 Attachment(s)

I did have to re-arrange your data a little

Code:

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

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

Code:

'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

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

1 Attachment(s)

1. No problem

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

Attachment 25468

The output is in the same order as the input

How would you like it sorted?

@Paul

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

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

:runaway:

1 Attachment(s)

Quote:

Originally Posted by 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

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)"

Code:

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

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

Thanks for the help.

1 Attachment(s)

Quote:

I'm new to VBA and in programming in general

First, you must define all the Features

If the EW Score is changed on sheet2, refresh all names in the "Query" (name) Column to the Results table
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
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

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