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
25457

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

Also, in sheet2 I want the output to be like:
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.

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

25468

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]

:runaway:

[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:thumb

Thanks for the help.

[SamT]

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.