locked
VBA code - help needed - difficult case RRS feed

  • Question

  • Hello,

    I have a quite complicated problem with writing an appropriate VBA code - if it is possible at all. I will try to describe this issue precisely and maybe someone will be able and willing to help me with it.

    So, the thing is as follows:

    I have four tables which I work on them. I go through an excel worksheet downwards and catch this tables, which are separated by emtpy rows. That can I do, so lets assume we have such a one set of four tables. Exactly, there are four tables of the same dimensions, and to say more - there are tables of one column and a variable number of rows. But when I catch such a selection of four tables these are of the same dimension, one column and e.g ten rows, each of them. They can be placed in different columns, e.g. A, C, E, G - it doesen't matter because I will manage this issue with an offset function. But lets assume, there is a one particular case in which arrangement is as that: A, C, E, G. So they are placed in named columns and in the same rows, they are arranged horizontaly - the same up and down boarder line.

    Having this set of tables I should do something, which I do not know wheter it is possible or not - I can't write such a code, I am still too weak in VBA programming.

    First of all, I work on tables in columns A and C. I have to check the first condidition: Are there at least two the same values(it is text) in column C for which there are different values in column A ? If not, I leave this set of tables and go down - I get an answer in a cell in which I put a macro like "OK".

    If it is the case, I need to select this cells(actually rows), for which this condidion is met. So there can be e.g six the same vaules in table in column C, if we have in the same rows in column A six the same values ( it does not mean, they are the same as in column C, they should not differ between themselves) it is ok, but if we have e.g five the same and one is another, or we have four the same and the next two are the same but differ from that four, or they can even be deifferent between themselves I always need to select all six rows, all rows in which cells in column C are the same. An example:

    Column A    Column C

    Tadek            Jarek

    Tadek            Jarek

    Grzesiek        Jarek

    Tomek           Wladek

     

    In this case I need to select three first rows. In this case e.g:

    Column A        Column C

    Antek               Jarek

    Tomek             Jarek

    Olek                 Rysiek

    Grzesiek          Rysiek

     

    Here I need to select two different sets of rows, on which I will work in next steps. These are two first rowns, and the next selection are two last rows.

     

    In this case

    Column A        Column C

    Antek               Jarek

    Tomek             Jarek

    Szczepan         Rafal

    Olek                 Rysiek

    Grzesiek          Rysiek

     

    I also need to select two first rows and as the second selection, two last rows. I thought, they colud be treaten as new, smaller tables.

    So, if we catch such a case, we select appriopriate rows and then go to the tables in columns E and G. Some numbers are there. Lets look at this case

    Column A    Column C   Column E    Column G

    Tadek            Jarek         1000           50

    Tadek            Jarek         1000             600

    Grzesiek        Jarek          2000           1500

    Tomek           Wladek       500            500

     

    So we check the first condition, so the result is, that it is met and we shold then work on the first three rows. Lets imagine it:

    Column A    Column C   Column E    Column G

    Tadek            Jarek         1000           50

    Tadek            Jarek         1000             600

    Grzesiek        Jarek          2000           1500

    And here we have to chec if the sum of the numbers in table in column G is bigger than the sum of nonduplicated values from table in Column E. In this case we have 50 + 600 + 1500 < 1000 + 2000. And this is "OK". IF it is a case I need a returned "OK" statement, if not "Control"

    It is too hard for me to write such a code. There is a problem with the selection of appriopriate rows, then we have to compare the sum of the cells in this rows in table in column G, with the sum of unique values from the cells in selected rows in Column E. Is it possible at all?

    One more example:

        Column A        Column C          Column E      Column  G

    1    Ford                  Lexus                5000            5000

    2   Ford                  Lexus                5000            5000

    3   Nissan               Lexus                5000              100

    4    Ferrari              Lexus                 5000              150

    5    Bentley             KIA                       30                 40

    6    Suzuki              Lexus                1000               100

    7    Toyota             Mazda                2000                1000

    8    Volvo               Mazda               2000                 500

     

    So, we selekt two different sets of rows which we have to examine

    One set is 1,2,3,4,6  so we have to check if sum of (5000, 5000, 100, 150, 100) is less than sum of (5000 and 1000). Then we check the next set of rows i.e. 7 and 8. So we have to check if sum of 1000 and 500 is less than 2000.

    It can be more than two of such sets. And if the secon condition is not met in at least on of them I need a return value "Control". But if the condition "less than" is met in all of the selected sets of rows, I need a return value "Ok".

     

    Is it possible to write such a code? For me not. Any help? I will be grateful till my dying day.

     

    regards

     

    Radek

     

    Monday, November 29, 2010 2:56 PM

Answers

  • Hello Radek,

    I though it would be smaller.. hehe. But after start, I should go to the end. Forgive me all the anti-patterns, magic numbers and so on. The idea is to give you only the way to do it. The code cleaning / tyding is up to you.

    Some things to notice:

    1- Instead of improve the array handling, I used some array functions already available by mr. Pearson: http://www.cpearson.com/excel/VBAArrays.htm. You will need to add this module .bas (http://www.cpearson.com/Zips/modArraySupport.zip) into your project to make it work.

    2- The results are only being prompted on the immediate window; don't know what you'd like to do with them / how you'll handle them

    3- I've defined an Excel range as myRangeValues, containing the last example you gave (with car names and that stuff).

    4- Just read, the idea for column E is to get the unique values. It's simple to do having the code below.

     

    Option Explicit
    
    Public Sub MyFilter()
      
      Dim colValues As Collection
      Dim myRange As Excel.Range
      
      Set myRange = [myRangeValues]
      
      Set colValues = GroupValuesFromRange(myRange)
      
      ProcessValuesFromCollection colValues
      
    End Sub
    
    Private Function GroupValuesFromRange(ByRef oRange As Excel.Range) As Collection
      
      Dim colResult As Collection
      Dim oRow As Excel.Range
      
      Dim sIndex As String
      
      Dim vRow As Variant
      Dim vTable As Variant
      
      Dim lRows As Long
      Dim lCols As Long
      
      Set colResult = New Collection
      
      For Each oRow In oRange.Rows
        
        vRow = ConvertRangeInto1DArray(oRow.Value)
        
        sIndex = vRow(2)
        
        vTable = ProcessIndex(oRange, sIndex)
        
        If Not keyExists(colResult, sIndex) Then
        
          colResult.Add vTable, sIndex
        
        End If
        
      Next oRow
      
      Set GroupValuesFromRange = colResult
      
    End Function
    
    Private Function ProcessIndex(ByRef oRange As Excel.Range, sIndex As String) As Variant
      
      Dim vResult() As Variant
      Dim vRow() As Variant
      Dim oRow As Excel.Range
      Dim sCurrIndex As String
      Dim iCount As Integer
      
      iCount = -1
      
      For Each oRow In oRange.Rows
        
        vRow = ConvertRangeInto1DArray(oRow.Value)
        
        sCurrIndex = vRow(2)
        
        If sCurrIndex = sIndex Then
          
          ReDim Preserve vResult(iCount + 1)
          
          vResult(iCount + 1) = vRow
          
          iCount = iCount + 1
          
        End If
        
      Next oRow
      
      ProcessIndex = vResult
      
    End Function
    
    Private Function keyExists(myCollection As Collection, sKey As String) As Boolean
     On Error GoTo handleerror:
    
     Dim val As Variant
    
     val = myCollection(sKey)
     keyExists = True
     Exit Function
    handleerror:
     keyExists = False
    End Function
    
    Private Sub ProcessValuesFromCollection(ByRef oCollection As Collection)
      
      Dim oItem As Variant
      Dim iCounter As Integer
      
      For iCounter = 1 To oCollection.Count
        
        ProcessValuesFromCollectionByIndex oCollection.Item(iCounter)
        
      Next iCounter
      
    End Sub
    
    Private Function ConvertRangeInto1DArray(ByRef vRange As Variant) As Variant
      
      Dim iCount As Integer
      Dim vResult() As Variant
      
      ReDim vResult(UBound(vRange, 2) - 1)
      
      For iCount = LBound(vRange, 2) - 1 To UBound(vRange, 2) - 1
        
        vResult(iCount) = vRange(1, iCount + 1)
        
      Next iCount
      
      ConvertRangeInto1DArray = vResult
      
    End Function
    
    Private Sub ProcessValuesFromCollectionByIndex(ByRef vTable As Variant)
      
      Dim lSumColG As Long
      Dim lColE As Long
      Dim iCount As Integer
      Dim vRow As Variant
      
      For iCount = LBound(vTable) To UBound(vTable)
        
        vRow = vTable(iCount)
        
        If lColE = 0 Then
          
          lColE = vRow(4)
          
        End If
        
        lSumColG = vRow(6) + lSumColG
        
      Next iCount
      
      Debug.Print vRow(2) & ": Column E = " & lColE & " / Sum Column G = " & lSumColG
      
    End Sub
    
    


    Tiago Cardoso VB / VBA Analyst
    • Proposed as answer by TiagoCardoso Tuesday, November 30, 2010 2:58 PM
    • Marked as answer by Bruce Song Monday, December 6, 2010 6:51 AM
    Tuesday, November 30, 2010 2:57 PM
  • Update:

    As I've seen that the ColumnE logic was wrong, please use the code below replacing the old code in my previous post for the same functions. It will give a more accurate (and clear to understand) calculation for both columns E and G.

    Ah, please change these odd names with something with meaning within your application.. hehe. ColumnE and ColumnG are awful names :-)

    Private Sub ProcessValuesFromCollectionByIndex(ByRef vTable As Variant)
      
      Dim lColumnE As Long
      Dim lColumnG As Long
    
      lColumnG = GetColumnGValueByIndex(vTable)
      lColumnE = GetColumnEValueByIndex(vTable)
      
      Debug.Print vTable(0)(2) & ": Column E = " & lColumnE & " / Sum Column G = " & lColumnG
      
    End Sub
    
    Private Function GetColumnGValueByIndex(ByRef vTable As Variant) As Long
      
      Dim iCount As Integer
      Dim vRow As Variant
      Dim lResult As Long
      
      For iCount = LBound(vTable) To UBound(vTable)
        
        vRow = vTable(iCount)
        
        lResult = vRow(6) + lResult
        
      Next iCount
      
      GetColumnGValueByIndex = lResult
      
    End Function
    
    Private Function GetColumnEValueByIndex(ByRef vTable As Variant) As Long
      
      Dim iCount As Integer
      Dim colValues As New Collection
      Dim lValue As Long
      Dim lResult As Long
      Dim vRow As Variant
      Dim vValue As Variant
      
      For iCount = LBound(vTable) To UBound(vTable)
        
        vRow = vTable(iCount)
        
        lValue = vRow(4)
        
        If Not keyExists(colValues, CStr(lValue)) Then
          
          colValues.Add lValue, CStr(lValue)
          
        End If
        
      Next iCount
      
      For Each vValue In colValues
        
        lResult = CLng(vValue) + lResult
        
      Next vValue
      
      GetColumnEValueByIndex = lResult
      
    End Function
    
    

    Hope it helps!


    Tiago Cardoso VB / VBA Analyst
    • Marked as answer by zielllik Thursday, December 9, 2010 7:49 AM
    Tuesday, November 30, 2010 5:08 PM

All replies

  • Second read...

    Please correct if I'm wrong... isn't missing a 1000 in this explanation? I bolded the info I believe is missing. If it's not, that's because these 1000 are related somehow to the 'Tadek' duplicated entries?

    So we check the first condition, so the result is, that it is met and we shold then work on the first three rows. Lets imagine it:

    Column A    Column C   Column E    Column G

    Tadek            Jarek         1000           50

    Tadek            Jarek         1000             600

    Grzesiek        Jarek          2000           1500

    And here we have to chec if the sum of the numbers in table in column G is bigger than the sum of nonduplicated values from table in Column E. In this case we have 50 + 600 + 1500 < 1000 + 1000 + 2000. And this is "OK". IF it is a case I need a returned "OK" statement, if not "Control"


    Tiago Cardoso VB / VBA Analyst
    Monday, November 29, 2010 4:53 PM
  • Hello,

    no, it is not missing. As I have written, I have to check whether the sum of values in cells in Column G is less than the sum of only unique values from Column E. So I reject all the duplicates, in this case it is a hundred replied twice. When it comes to your second question, no I can not assume, that it is related with 'Tadek" duplicated. It is usually so, but having been working on the data I have seen exceptions.

     

    regard

    Radek

    Tuesday, November 30, 2010 7:47 AM
  • Hello Radek,

    I though it would be smaller.. hehe. But after start, I should go to the end. Forgive me all the anti-patterns, magic numbers and so on. The idea is to give you only the way to do it. The code cleaning / tyding is up to you.

    Some things to notice:

    1- Instead of improve the array handling, I used some array functions already available by mr. Pearson: http://www.cpearson.com/excel/VBAArrays.htm. You will need to add this module .bas (http://www.cpearson.com/Zips/modArraySupport.zip) into your project to make it work.

    2- The results are only being prompted on the immediate window; don't know what you'd like to do with them / how you'll handle them

    3- I've defined an Excel range as myRangeValues, containing the last example you gave (with car names and that stuff).

    4- Just read, the idea for column E is to get the unique values. It's simple to do having the code below.

     

    Option Explicit
    
    Public Sub MyFilter()
      
      Dim colValues As Collection
      Dim myRange As Excel.Range
      
      Set myRange = [myRangeValues]
      
      Set colValues = GroupValuesFromRange(myRange)
      
      ProcessValuesFromCollection colValues
      
    End Sub
    
    Private Function GroupValuesFromRange(ByRef oRange As Excel.Range) As Collection
      
      Dim colResult As Collection
      Dim oRow As Excel.Range
      
      Dim sIndex As String
      
      Dim vRow As Variant
      Dim vTable As Variant
      
      Dim lRows As Long
      Dim lCols As Long
      
      Set colResult = New Collection
      
      For Each oRow In oRange.Rows
        
        vRow = ConvertRangeInto1DArray(oRow.Value)
        
        sIndex = vRow(2)
        
        vTable = ProcessIndex(oRange, sIndex)
        
        If Not keyExists(colResult, sIndex) Then
        
          colResult.Add vTable, sIndex
        
        End If
        
      Next oRow
      
      Set GroupValuesFromRange = colResult
      
    End Function
    
    Private Function ProcessIndex(ByRef oRange As Excel.Range, sIndex As String) As Variant
      
      Dim vResult() As Variant
      Dim vRow() As Variant
      Dim oRow As Excel.Range
      Dim sCurrIndex As String
      Dim iCount As Integer
      
      iCount = -1
      
      For Each oRow In oRange.Rows
        
        vRow = ConvertRangeInto1DArray(oRow.Value)
        
        sCurrIndex = vRow(2)
        
        If sCurrIndex = sIndex Then
          
          ReDim Preserve vResult(iCount + 1)
          
          vResult(iCount + 1) = vRow
          
          iCount = iCount + 1
          
        End If
        
      Next oRow
      
      ProcessIndex = vResult
      
    End Function
    
    Private Function keyExists(myCollection As Collection, sKey As String) As Boolean
     On Error GoTo handleerror:
    
     Dim val As Variant
    
     val = myCollection(sKey)
     keyExists = True
     Exit Function
    handleerror:
     keyExists = False
    End Function
    
    Private Sub ProcessValuesFromCollection(ByRef oCollection As Collection)
      
      Dim oItem As Variant
      Dim iCounter As Integer
      
      For iCounter = 1 To oCollection.Count
        
        ProcessValuesFromCollectionByIndex oCollection.Item(iCounter)
        
      Next iCounter
      
    End Sub
    
    Private Function ConvertRangeInto1DArray(ByRef vRange As Variant) As Variant
      
      Dim iCount As Integer
      Dim vResult() As Variant
      
      ReDim vResult(UBound(vRange, 2) - 1)
      
      For iCount = LBound(vRange, 2) - 1 To UBound(vRange, 2) - 1
        
        vResult(iCount) = vRange(1, iCount + 1)
        
      Next iCount
      
      ConvertRangeInto1DArray = vResult
      
    End Function
    
    Private Sub ProcessValuesFromCollectionByIndex(ByRef vTable As Variant)
      
      Dim lSumColG As Long
      Dim lColE As Long
      Dim iCount As Integer
      Dim vRow As Variant
      
      For iCount = LBound(vTable) To UBound(vTable)
        
        vRow = vTable(iCount)
        
        If lColE = 0 Then
          
          lColE = vRow(4)
          
        End If
        
        lSumColG = vRow(6) + lSumColG
        
      Next iCount
      
      Debug.Print vRow(2) & ": Column E = " & lColE & " / Sum Column G = " & lSumColG
      
    End Sub
    
    


    Tiago Cardoso VB / VBA Analyst
    • Proposed as answer by TiagoCardoso Tuesday, November 30, 2010 2:58 PM
    • Marked as answer by Bruce Song Monday, December 6, 2010 6:51 AM
    Tuesday, November 30, 2010 2:57 PM
  • Hello Tiago,

    I am very grateful for your help. I will try do go through the code during this weekend because of a lack of time now. It looks for me like a black magic :) I hope I will be able to make use of it and apply the result of your work.

    best regards

    Radek

    Tuesday, November 30, 2010 3:52 PM
  • Hello Tiago,

    I am very grateful for your help. I will try do go through the code during this weekend because of a lack of time now. It looks for me like a black magic :) I hope I will be able to make use of it and apply the result of your work.

    best regards

    Radek

    Great, buddy!

    As I'm going to be on Holidays next week.. in case this code (for any reason) doesn't fit your expectations, I'm sure we have some folks here in the community who are able to offer a even clearer solution for it.

    On the other hand if it works... just set as answered and we'll know that another question is closed :-)

    Hope it helps!

    Cheers


    Tiago Cardoso VB / VBA Analyst
    Tuesday, November 30, 2010 4:41 PM
  • Update:

    As I've seen that the ColumnE logic was wrong, please use the code below replacing the old code in my previous post for the same functions. It will give a more accurate (and clear to understand) calculation for both columns E and G.

    Ah, please change these odd names with something with meaning within your application.. hehe. ColumnE and ColumnG are awful names :-)

    Private Sub ProcessValuesFromCollectionByIndex(ByRef vTable As Variant)
      
      Dim lColumnE As Long
      Dim lColumnG As Long
    
      lColumnG = GetColumnGValueByIndex(vTable)
      lColumnE = GetColumnEValueByIndex(vTable)
      
      Debug.Print vTable(0)(2) & ": Column E = " & lColumnE & " / Sum Column G = " & lColumnG
      
    End Sub
    
    Private Function GetColumnGValueByIndex(ByRef vTable As Variant) As Long
      
      Dim iCount As Integer
      Dim vRow As Variant
      Dim lResult As Long
      
      For iCount = LBound(vTable) To UBound(vTable)
        
        vRow = vTable(iCount)
        
        lResult = vRow(6) + lResult
        
      Next iCount
      
      GetColumnGValueByIndex = lResult
      
    End Function
    
    Private Function GetColumnEValueByIndex(ByRef vTable As Variant) As Long
      
      Dim iCount As Integer
      Dim colValues As New Collection
      Dim lValue As Long
      Dim lResult As Long
      Dim vRow As Variant
      Dim vValue As Variant
      
      For iCount = LBound(vTable) To UBound(vTable)
        
        vRow = vTable(iCount)
        
        lValue = vRow(4)
        
        If Not keyExists(colValues, CStr(lValue)) Then
          
          colValues.Add lValue, CStr(lValue)
          
        End If
        
      Next iCount
      
      For Each vValue In colValues
        
        lResult = CLng(vValue) + lResult
        
      Next vValue
      
      GetColumnEValueByIndex = lResult
      
    End Function
    
    

    Hope it helps!


    Tiago Cardoso VB / VBA Analyst
    • Marked as answer by zielllik Thursday, December 9, 2010 7:49 AM
    Tuesday, November 30, 2010 5:08 PM
  • Unfortunatelly I have not had time during the weekend but I believe I will find an answer in this code, so I mark it as answer and many thanks again.

     

    regards

     

    Radek

    Thursday, December 9, 2010 7:49 AM