Pull data based on user input

Hi Friends,

By using VBA, I am supposed to pull data based on user input, Column is fixed but rows are not fixed.

Based on cell value C5 to C8 (Values will change), data main table should get filtered out.

I have attached example file with more details
Pull data based on cell value.xlsm


Thanks & Regards

Hi Mani

I'm intrigued why Group 2 doesn't get included?

The value is between 80,000 and 160,000 (110,665) and at least one of the entities A thru G has a % share between 10% and 30%.

Also, if your second requirement is true (the % share) then why are entities A and C included in Group 5? (% share < 10% in each case).

Could you perhaps elucidate and refine your requirements? They don't make clear sense at present!

Thanks,

Tony

Hi tfurnivall,

Group 2 is not included because cell P2 value is 40% which is greater than the input value of 40% in cell C8, so that full gr is excluded from the result

And sorry for Group 5, that is a mistake, it should not be included.

Sorry for the confusion.

So, to restate the requirements for your filter, we have the following:

For each row (looking at total value
    If Total value is between LowConstraint and HighConstraint then
       for every Share in ShareA thru ShareG
           if sharepercent is between LowShareConstraint and HighShareConstraint then
              We want this entry
           endif
       next Share
    endif
Next Row

Note, of course, that there is no such construct as For every, so we'lll have to code around it!

Does this accurately reflect your constraint? And if we take that second loop (For every) and recode it like this:

For each row (looking at total value
    If Total value is between LowConstraint and HighConstraint then
       We want this entry
       Start with Share A
       While we want this entry
           if sharepercent is less than LowShareConstraint or > HighShareConstraint then
              We certainly DON'T want this entry
           endif
           Look at the next share
       Wend
    End If
    If We Want This Eentry then
       Deal with this entry
    End   
    endif
Next Row

, does that give you enough help to finish it off on your own?

If so, great!

If not, let's continue to talk!

Tony

Tony, I am new to VBA coding. Your explanation is good, but can you please post the full code.

As on my own i am not able to complete it.

Sorry for the extra work.

I'm always tempted to say, at times like this, "If I write your code, will you send me your paycheck?"

So, I'll get you started, but you need to do most of the work yourself, otherwise you'll never learn anymore, will you!

So here's a spreadsheet with some skeleton code:

Sub ExtractFilteredData()

'   Build a range of filtered data, using the FilterConstraints range to extract data
'   from the MainDataRange, into the ExtractRange.

'   Translate the arbitrary data setup into constants. That way, if anything changes,
'   you need only change one part of the code!

Const ConstraintsAddress = "$A$5"   '   Origin of the Constraints area
Const ConstraintValuesOffset = 2    '   Constraint values are two columns over
Const LowSalesOffset = 0            '   LowSales is same line as the origin
Const HighSalesOffset = 1           '   High Sales is 1 row down
Const LowShareOffset = 2            '   Low share is 2 rows down
Const HighShareOffset = 3           '   High share is 3 rows down

Const MainDataAddress = "$A$10"     '   Origin of the MainData area
Const MainDataFirstRowOffset = 1    '   First data row in MainData
Const MainDataNumCols = 19          '   Dimensions of MainData
Const MainDataNumRows = 17
Const MainDataSalesOffset = 4       '   Total value is 4 columns over
Const MainDataFirstShareOffset = 12 '   Share A is 12 columns over
Const MainDataNumShares = 7

Const ExtractAddress = "$B$31"      '   Origin
Const ExtractFirstRowOffset = 3     '   First Row in extract area
Const ExtractNumCols = 9            '   Key + Value + 7 Shares

Dim LowSalesAddress As String       '   Low sales filter definition
Dim LowSales As Range
Dim LowSalesValue As Long

Dim HighSalesAddress As String      '   High sales filter definition
Dim HighSales As Range
Dim HighSalesValue As Long

Dim LowShareAddress As String       '   Low Share filter definition
Dim LowShare As Range
Dim LowShareValue As Single

Dim HighShareAddress As String      '   High Share filter definition
Dim HighShare As Range
Dim HighShareValue As Single

Dim ThisGroupIndex As Long
Dim ThisGroupAddress As String
Dim ThisGroup As Range

Dim ThisExtractIndex As Long
Dim ThisExtractAddress As String
Dim ThisExtract As Range

Dim ThisShareIndex As Long
Dim ThisShareAddress As String
Dim ThisShare As Range
Dim ShareOffset As Long

Dim GroupIsSelected As Boolean

'   Build the filter values
LowSalesAddress = Range(ConstraintsAddress).Offset(LowSalesOffset, ConstraintValuesOffset).Address
LowSalesValue = Range(LowSalesAddress).Value
'HighSalesAddress=
'highsalesvalue=
'LowShareAddress=
'lowsharevalue=
'HighShareAddress=
'highsharevalue=

'   Initialize the loop
ThisGroupIndex = 0
Set ThisGroup = DefineThisGroup(MainDataAddress, _
                                MainDataFirstRowOffset, _
                                ThisGroupIndex, _
                                ThisGroupAddress)
ThisExtractIndex = 0

'   Look at each Group's total value

While ThisGroup.Value > ""
      Debug.Print "Group #"; ThisGroupIndex + 1, ThisGroup.Address, ThisGroup.Value, ThisGroup.Offset(0, MainDataSalesOffset).Value
      If ThisGroup.Offset(0, MainDataSalesOffset).Value < LowSalesValue Or _
         ThisGroup.Offset(0, MainDataSalesOffset).Value > HighSalesValue Then
         GroupIsSelected = False
      Else
         ShareOffset = MainDataFirstShareOffset
         While ShareOffset < MainDataFirstShareOffset + MainDataNumShares And _
               GroupIsSelected
               '    Any share that fails to qualify will reject the entire group
               Set ThisShare = DefineThisShare(MainDataAddress, _
                                               MainDataFirstRowOffset, _
                                               ThisGroupIndex, _
                                               MainDataFirstShareOffset, _
                                               ShareOffset, _
                                               ThisShareAddress)
               If ThisShare.Value < LowShareValue Or _
                  ThisShare.Value > HighShareValue Then
                  GroupIsSelected = False   '   Deny the entire group
               End If
         Wend
      End If
      ' See if we need to extract the group
      If GroupIsSelected Then
         ThisExtract = ThisExtract + 1
         Set ThisExtract = DefineThisExtract(ExtractAddress, _
                                             ExtractFirstRowOffset, _
                                             ThisExtractIndex, _
                                             ThisGroupAddress)
         ExtractGroupData ThisGroup, ThisExtract, _
                          MainDataSalesOffset, _
                          MainDataFirstShareOffset, _
                          LowShareValue, HighShareValue
      End If
      ' Calculate next values for ThisGroup
      ThisGroupIndex = ThisGroupIndex + 1
      Set ThisGroup = DefineThisGroup(MainDataAddress, _
                                      MainDataFirstRowOffset, _
                                      ThisGroupIndex, _
                                      ThisGroupAddress)
Wend

End Sub


Function DefineThisGroup(DataAddress As String, FirstRowOffset As Long, GroupIndex As Long, GroupAddress As String) As Range

Dim rng As Range

'   GroupIndex is the row offset from the start of the main data table
'   Calculate the GroupAddress and create the range, for the row in GroupIndex

'   We need to add the FirstRow offset AND the GroupIndex (which points to rows) together
'   to create a Row offset, and then use this offset to create a range which will give us
'   the GroupRange

Debug.Print "DefineGroup #"; GroupIndex,

Set rng = Range(DataAddress).Offset(FirstRowOffset + GroupIndex, 0) '   Row offset is what hanges
GroupAddress = rng.Address
Debug.Print GroupAddress

Set DefineThisGroup = rng

Set rng = Nothing           '   We do this for some pretty advanced technical reasons
                            '   It IS important - don't omit it!

End Function

Function DefineThisExtract(ExtractAreaAddress As String, _
                           FirstRowOffset As Long, _
                           ExtractIndex As Long, _
                           ExtractAddress As String) As Range

Dim rng As Range

'   ExtractIndex is the row offset from the start of the extract area
'   Calculate the ExtractAddress and create the range, for the row in ExtractIndex

ExtractAddress = rng.Address
Set DefineThisExtract = rng

'   What do you need to add here?

End Function

Function DefineThisShare(DataAddress As String, _
                         FirstRowOffset As Long, _
                         GroupIndex As Long, _
                         FirstShareOffset As Long, _
                         ShareOffset As Long, _
                         ShareAddress As String) As Range

Dim rng As Range

'   GroupIndex is the row offset from the start of the data area; ShareOffset is
'   the column offset from the start of the Share columns
'   Calculate the ShareAddress and create the range, for the share column in ShareOffset
'   Remember that we need to add on the offset for the first share!

'   You should be able to do thisone by yourself

'   Shareaddress?

'   Definethisshare?

'   Important clean-up code?

End Function

Sub ExtractGroupData(ThisGroup As Range, ThisExtract As Range, _
                     SalesOffset As Long, ShareOffset As Long, _
                     LowShareValue, HighShareValue)

'   Extract data - remembering to extract only those shares that meet the criteria!

'   Create a new entry, and transfer the Group Name

'   Transfer the Sales value

'   Examine the Share values, and for each one that is within the criteria
'   copy that value - otherwise copy blanks!

End Sub

You'll notice that the first thing I've done is to put all of the very specific cell addresses into constants. THis avoids what are called, in the trade, 'magic numbers'. If you have a magic number and you need to change it, you need to be able to distingish between one meaning of the magic number (say 11) and another. At one time it might mean the number of players on the field for a soccer team, and at another, it might mean the number of months left in the year on February 1st. So rule #1:
ALWAYS GIVE CONSTANT VALUES A NAME - that way when they change (which is why they're called constants, right ) you only have to change them in one place. In your case, there are a lot of constants involved, but if your boss decides to add three more columns of data, you'll only need to change a few constants (depending on where those columns get added, and what they are!)

Second - you have indicated that both constraints need to be true (Value AND Share). So I've coded it this way. If either one needs to be true (or if ANY share needs to match the Share constraints) then the logic changes - quite dramatically. But again, there's only a limited number of places that need to change.

Third, some parts of the code need considerably more detailed calculation than others. Using a technique called Stepwise refinement, we simply shunt the active development of those parts off until later. You'll see this happen as I need to define a Group, a Share and an Extract. Simply declare the function or procedure, and then worry about coding it later. (You'll note that I've only developed one of the three functions - the others are for you to do!)

Lastly, always try and run your code as early and as often as possible. It's much easier to find problems from code that is running. Exceedingly true in COBOL programs (which are sometimes many thousands of lines long), but equally true in VBA. Sprinkle your code with debug statements, so you can see how things are progressing.

So, take a look at this code (it's in the attached spreadsheet), and see how you go on filling out some of the gaps,

HTH

Tony

PS I really don't want to deprive you of your paycheck, but you might want to give me some reputation...