VBA code - help needed - difficult case

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

 

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

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

Answer 7

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