Answered by:
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
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 AnalystMonday, 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 AnalystTuesday, 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