Excel Howto?
Excel VBA how to?

-Aviral Mittal




1. How to get values from a different Column based upon a match criteria
A Excel sheet has Country Names in Column 1.
Country's produce/produce in Column2
Now it is desired for example a list of all countries which produce a common product.
This will be more clear from the figure shown below:



The objective here is to get say all Cocoa producing countries. Or Say all Cotton Producing Countries.
Solution:
1. Find the list of row numbers of match criteria, say for example a list of all row numbers with Cotton is
3,7,13
2. Find the values in Column A (1) for these rows.

The following function does the job 1, finds the Comma Separated String of row numbers containing a string
'------------------------
Function FindStrInColCSV(fStr As String, colNum As Long, Optional shtName As String) As String
'This function will find all occurences of 'fStr' in a named, given column and return a CSV String of Row Numbers
'Example Use : MsgBox FindStrInColCSV("Cotton", 2, "Sheet2")
'This will return a CSV of all rows number if and where the string 'fStr' was found in column 'colNum'
'Return value is "1,3,5,8,9" kinda
Dim sht As Worksheet
Dim mCell As Range
Dim rStr As String


If (shtName = "") Then
  shtName = "Sheet2"
End If
  On Error GoTo errorHandler
  Set sht = ThisWorkbook.Worksheets(shtName)
  On Error GoTo 0 'Null the effect of goto errorHandler above.
 
  sht.Activate
  If colNum = 0 Then 'Wrong entry, default it to 1
    colNum = 1
  End If
 
  rStr = ColNum2Ch(colNum) & ":" & ColNum2Ch(colNum)
 
  Set mCell = Columns(rStr).Find(What:=fStr, lookat:=xlWhole) 'searchStr is the string which is being searched
  'MsgBox mCell.Address
 
  If mCell Is Nothing Then
    Debug.Print "ERROR! From Function 'FindStrInColCSV': fStr '" & fStr & "' not found in sheet '" & shtName & "'" & " in given col = " & colNum
    MsgBox "ERROR! From Function 'FindStrInColCSV': fStr " & "'" & fStr & "'" & " not found in sheet '" & shtName & "'" & " in given col = " & colNum
    Exit Function
  Else
    FindStrInColCSV = Split(mCell.Address, "$")(2)
    'Debug.Print "INFO: From Function 'FindStrInColCSV': Found '" & fStr & "' Address = " & mCell.Address & " In Sheet '" & shtName & "'"
  End If

  Dim firstCellAddress As String
  firstCellAddress = mCell.Address
  Dim ii As Long
  ii = 0
  Do
    ii = ii + 1
    'MsgBox mCell.Address & " " & ii
    If (Not ii = 1) Then
      FindStrInColCSV = FindStrInColCSV & "," & Split(mCell.Address, "$")(2)
    End If
    Set mCell = Columns(rStr).FindNext(mCell)
   
  Loop While Not mCell Is Nothing And firstCellAddress <> mCell.Address

  Exit Function
errorHandler:
  Debug.Print "ERROR! From Function 'FindStrInColCSV': Sheet " & "'" & shtName & "'" & " Does not exist"
  MsgBox "ERROR! From Function 'FindStrInColCSV': Sheet " & "'" & shtName & "'" & " Does not exist"

End Function
Function ColNum2Ch(colNum As Long) As String
  ColNum2Ch = Split(Split(Columns(colNum).Address, "$")(1), ":")(0)
End Function
'---------------------------------------------------------------------------------------
Then the follwoing function gets the values from the rows returned from Above Function in a given Coumn


Function getValsForRowVec(rowVecCSV As String, colNum As Long, Optional shtName As String) As String
'This function will take in a CSV of row numbers e.g. "2,4,7,10" and return corresponding cell values from row,colNum cell
'Example usage getValsForRowVec("2,3,4,5,9",5)
'Example usage 2 getValsForRowVec(FindStrInColCSV("Cotton", 2, "Sheet2"),1)
'The above example finds Cotton in Col number 2, then gets the values from same rows from Col1
  Dim element As Variant
  Dim ii As Long
  Dim sht As Worksheet
  ii = 0
  If (shtName = "") Then
    shtName = "Sheet2"
  End If
  On Error GoTo errorHandler
  Set sht = ThisWorkbook.Worksheets(shtName)
  On Error GoTo 0 'Null the effect of goto errorHandler above.
 
  sht.Activate

  For Each element In Split(rowVecCSV, ",")
    If (ii = 0) Then
      getValsForRowVec = Range(ColNum2Ch(colNum) & element).Value
    Else
      getValsForRowVec = getValsForRowVec & "," & Range(ColNum2Ch(colNum) & element).Value
    End If
    ii = ii + 1
  Next element
    Exit Function
errorHandler:
  Debug.Print "ERROR! From Function 'getValsForRowVec': Sheet " & "'" & shtName & "'" & " Does not exist"
  MsgBox "ERROR! From Function 'getValsForRowVec': Sheet " & "'" & shtName & "'" & " Does not exist"
End Function

Sub Try
  msgBox getValsForRowVec(FindStrInColCSV("Cotton", 2, "Sheet2"),1,"Sheet2")
End Sub
The above Subroutine 'Try' will return "China,Turkey,India" as these are all the countries with "Cotton" in Col 2

The WB with the above code can be downloaded here: (The example lists shown in diagram is in Sheet2)
Book6.xlsm


<- Previous                                                                                                Next ->

Key Words: Excel VBA to implement Filters. Col value based upon match criteria