| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Special sum of texts
Hello,
I try to write macro which will sum text in new column, but in special way, but it is to complicated for me. How is should works: - when in data3 or data4 is bbxx (when xx is 01,02 €¦) then in column SUM for all line containing this data should be bbxx - when in data2 is aax and data3, data4 are empty then SUM is aax - when in data 3 or 4 cccxx and data2 is empty then SUM is cccxx - when in data 3 or 4 is bbxx and in data3 and data4 is cccxx then SUM for all line containing this data is cccxx - when in data3 or 4 is cccxx and in data 3 or 4 is cccxy for all this line SUM is cccxx+cccxy - when in data2 is aaxx and is data3 or 4 is cccxx then in all line SUM is cccxx - when in data2 is aaxx and aaxy and in data3 or 4 is cccxx and cccxy then SUM is cccxx+cccxy Example data1 data2 data3 data4 SUM 1 2 bb01 bb01 3 bb01 bb01 4 ccc02 ccc02 5 ccc06 ccc06+ccc07 6 ccc02 ccc02 7 ccc06 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 ccc07 ccc06+ccc07 10 bb02 ccc01 11 ccc01 bb02 ccc02 12 cc01 ccc03 13 ccc03 ccc03 14 aa1 ccc03 ccc03 15 aa1 ccc03 16 aa2 ccc04 ccc04+ccc05 17 aa3 ccc04 ccc04+ccc05 18 aa2 ccc05 ccc04+ccc05 19 aa3 ccc05 ccc04+ccc05 20 aa4 aa4 21 aa4 aa4 All this connections can be joint together like he 22 bb03 ccc08+ccc09+ccc10 23 bb03 ccc10 ccc08+ccc09+ccc10 24 ccc10 ccc08+ccc09+ccc10 25 ccc09 ccc08+ccc09+ccc10 26 ccc08 ccc08+ccc09+ccc10 27 aa5 ccc08 ccc08+ccc09+ccc10 28 aa5 ccc09 ccc08+ccc09+ccc10 29 aa5 ccc10 ccc08+ccc09+ccc10 Best Regards, Bartosz |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
Try this
Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount For RowCount = 1 To LastRow If Range("C" & RowCount) = "" And _ Range("D" & RowCount) = "" Then If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then Range("E" & RowCount) = Range("B" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If End If End If End If Next RowCount End Sub "Bartosz" wrote: Hello, I try to write macro which will sum text in new column, but in special way, but it is to complicated for me. How is should works: - when in data3 or data4 is bbxx (when xx is 01,02 €¦) then in column SUM for all line containing this data should be bbxx - when in data2 is aax and data3, data4 are empty then SUM is aax - when in data 3 or 4 cccxx and data2 is empty then SUM is cccxx - when in data 3 or 4 is bbxx and in data3 and data4 is cccxx then SUM for all line containing this data is cccxx - when in data3 or 4 is cccxx and in data 3 or 4 is cccxy for all this line SUM is cccxx+cccxy - when in data2 is aaxx and is data3 or 4 is cccxx then in all line SUM is cccxx - when in data2 is aaxx and aaxy and in data3 or 4 is cccxx and cccxy then SUM is cccxx+cccxy Example data1 data2 data3 data4 SUM 1 2 bb01 bb01 3 bb01 bb01 4 ccc02 ccc02 5 ccc06 ccc06+ccc07 6 ccc02 ccc02 7 ccc06 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 ccc07 ccc06+ccc07 10 bb02 ccc01 11 ccc01 bb02 ccc02 12 cc01 ccc03 13 ccc03 ccc03 14 aa1 ccc03 ccc03 15 aa1 ccc03 16 aa2 ccc04 ccc04+ccc05 17 aa3 ccc04 ccc04+ccc05 18 aa2 ccc05 ccc04+ccc05 19 aa3 ccc05 ccc04+ccc05 20 aa4 aa4 21 aa4 aa4 All this connections can be joint together like he 22 bb03 ccc08+ccc09+ccc10 23 bb03 ccc10 ccc08+ccc09+ccc10 24 ccc10 ccc08+ccc09+ccc10 25 ccc09 ccc08+ccc09+ccc10 26 ccc08 ccc08+ccc09+ccc10 27 aa5 ccc08 ccc08+ccc09+ccc10 28 aa5 ccc09 ccc08+ccc09+ccc10 29 aa5 ccc10 ccc08+ccc09+ccc10 Best Regards, Bartosz |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
Thanks for try, but it takie only one line to find konections, but the same
name differend rows is thesame thing, so Your macro took only information from one row, but this macro have to look for data in all rows. I try ta add ma table onece again with infromation which I got after Your macro run. Your_macro Correct_SUM 1 bb01 bb01 bb01 2 bb01 bb01 bb01 3 ccc02 ccc02 ccc02 4 ccc02 ccc02 5 ccc06 ccc06 ccc06+ccc07 6 ccc06 ccc07 ccc06 ccc06+ccc07 7 ccc07 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 bb02 bb02 ccc01 10 ccc01 bb02 ccc01 ccc02 11 cc01 ccc03 12 ccc03 ccc03 ccc03 13 aa1 ccc03 ccc03 14 aa1 aa1 ccc03 15 aa2 ccc04 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 19 aa4 aa4 aa4 20 aa4 aa4 aa4 €˛Joel€¯ pisze: Try this Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount For RowCount = 1 To LastRow If Range("C" & RowCount) = "" And _ Range("D" & RowCount) = "" Then If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then Range("E" & RowCount) = Range("B" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If End If End If End If Next RowCount End Sub |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
I don't see the pattern in your data. I would need a much better description
of you requirements before I could accurately complete this task. "Bartosz" wrote: Thanks for try, but it takie only one line to find konections, but the same name differend rows is thesame thing, so Your macro took only information from one row, but this macro have to look for data in all rows. I try ta add ma table onece again with infromation which I got after Your macro run. Your_macro Correct_SUM 1 bb01 bb01 bb01 2 bb01 bb01 bb01 3 ccc02 ccc02 ccc02 4 ccc02 ccc02 5 ccc06 ccc06 ccc06+ccc07 6 ccc06 ccc07 ccc06 ccc06+ccc07 7 ccc07 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 bb02 bb02 ccc01 10 ccc01 bb02 ccc01 ccc02 11 cc01 ccc03 12 ccc03 ccc03 ccc03 13 aa1 ccc03 ccc03 14 aa1 aa1 ccc03 15 aa2 ccc04 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 19 aa4 aa4 aa4 20 aa4 aa4 aa4 €˛Joel€¯ pisze: Try this Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount For RowCount = 1 To LastRow If Range("C" & RowCount) = "" And _ Range("D" & RowCount) = "" Then If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then Range("E" & RowCount) = Range("B" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If End If End If End If Next RowCount End Sub |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
Hi,
Thanks for answering, what this table contains data: Column Data1 is components, Data2 semi products named aaxx Data3 and Data4 contain semi products contain name bbxx and cccxxx For simplest cases: If there is only bbxx and in any other row with bbxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx Data1 Data2 Data3 Data4 Correct_SUM 1 bb01 bb01 2 bb01 bb01 If there is only cccxx and in any other row with cccxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx 3 ccc02 ccc02 4 ccc02 ccc02 For aax in column Data2 and nothing more in data3 and Data4 the sum is aax 19 aa4 aa4 20 aa4 aa4 Of there is cccxx and in one with rows with cccxx is cccyy the sum for all rows with cccxx and cccyy is cccxx+cccyy (I add "*" to show row with connections) 5 ccc06 ccc06+ccc07 6* ccc06 ccc07 ccc06+ccc07 7 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 In Case when data3 and data4 contani cccxx and in one row with cccxx is bbxx then sum is only mane cccxx 9 bb02 ccc01 10* ccc01 bb02 ccc01 11 ccc01 ccc01 Similar in case with aaxx in Data2 and cccxxin column Data3 or Data4 12 ccc03 ccc03 13* aa1 ccc03 ccc03 14 aa1 ccc03 And one with complicated situation column Data3 or data4 contain cccxx and cccyy and in the same row in column Data2 contain aaxx for both cccxx and cccyy 15 aa2 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 Another situation ccc06 join with ccc07 and ccc08 with ccc09, but i the same time ccc06 connect with aa5 which is connected with ccc08, and second ccc07-aa7-ccc09 22 aa5 ccc06 ccc06+ccc07+ccc08+ccc09 23 aa6 ccc06 ccc07 ccc06+ccc07+ccc08+ccc09 24 aa7 ccc07 ccc06+ccc07+ccc08+ccc09 25 aa8 ccc06 ccc06+ccc07+ccc08+ccc09 26 aa5 ccc08 ccc06+ccc07+ccc08+ccc09 27 aa6 ccc08 ccc09 ccc06+ccc07+ccc08+ccc09 28 aa7 ccc09 ccc06+ccc07+ccc08+ccc09 29 aa8 ccc08 ccc06+ccc07+ccc08+ccc09 So only when bbxx or aaxx is alone then is sum there is bbxx or aaxx, but when this manes is with name cccxx only cccxx is in sum. Connections between cccxx and cccyy make sum cccxx+cccyy. Now I do it manually but for long sum of cccxx (once I got 18 cccxx is SUM - similar to last example with ccc06+ccc07+ccc08+ccc09) I could make mistake. €˛Joel€¯ pisze: I don't see the pattern in your data. I would need a much better description of you requirements before I could accurately complete this task. "Bartosz" wrote: Thanks for try, but it takie only one line to find konections, but the same name differend rows is thesame thing, so Your macro took only information from one row, but this macro have to look for data in all rows. I try ta add ma table onece again with infromation which I got after Your macro run. Your_macro Correct_SUM 1 bb01 bb01 bb01 2 bb01 bb01 bb01 3 ccc02 ccc02 ccc02 4 ccc02 ccc02 5 ccc06 ccc06 ccc06+ccc07 6 ccc06 ccc07 ccc06 ccc06+ccc07 7 ccc07 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 bb02 bb02 ccc01 10 ccc01 bb02 ccc01 ccc02 11 cc01 ccc03 12 ccc03 ccc03 ccc03 13 aa1 ccc03 ccc03 14 aa1 aa1 ccc03 15 aa2 ccc04 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 19 aa4 aa4 aa4 20 aa4 aa4 aa4 €˛Joel€¯ pisze: Try this Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount For RowCount = 1 To LastRow If Range("C" & RowCount) = "" And _ Range("D" & RowCount) = "" Then If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then Range("E" & RowCount) = Range("B" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If End If End If End If Next RowCount End Sub |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
What are the requirements for row being connected? This must be resolved
before anything alse is done. "Bartosz" wrote: Hi, Thanks for answering, what this table contains data: Column Data1 is components, Data2 semi products named aaxx Data3 and Data4 contain semi products contain name bbxx and cccxxx For simplest cases: If there is only bbxx and in any other row with bbxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx Data1 Data2 Data3 Data4 Correct_SUM 1 bb01 bb01 2 bb01 bb01 If there is only cccxx and in any other row with cccxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx 3 ccc02 ccc02 4 ccc02 ccc02 For aax in column Data2 and nothing more in data3 and Data4 the sum is aax 19 aa4 aa4 20 aa4 aa4 Of there is cccxx and in one with rows with cccxx is cccyy the sum for all rows with cccxx and cccyy is cccxx+cccyy (I add "*" to show row with connections) 5 ccc06 ccc06+ccc07 6* ccc06 ccc07 ccc06+ccc07 7 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 In Case when data3 and data4 contani cccxx and in one row with cccxx is bbxx then sum is only mane cccxx 9 bb02 ccc01 10* ccc01 bb02 ccc01 11 ccc01 ccc01 Similar in case with aaxx in Data2 and cccxxin column Data3 or Data4 12 ccc03 ccc03 13* aa1 ccc03 ccc03 14 aa1 ccc03 And one with complicated situation column Data3 or data4 contain cccxx and cccyy and in the same row in column Data2 contain aaxx for both cccxx and cccyy 15 aa2 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 Another situation ccc06 join with ccc07 and ccc08 with ccc09, but i the same time ccc06 connect with aa5 which is connected with ccc08, and second ccc07-aa7-ccc09 22 aa5 ccc06 ccc06+ccc07+ccc08+ccc09 23 aa6 ccc06 ccc07 ccc06+ccc07+ccc08+ccc09 24 aa7 ccc07 ccc06+ccc07+ccc08+ccc09 25 aa8 ccc06 ccc06+ccc07+ccc08+ccc09 26 aa5 ccc08 ccc06+ccc07+ccc08+ccc09 27 aa6 ccc08 ccc09 ccc06+ccc07+ccc08+ccc09 28 aa7 ccc09 ccc06+ccc07+ccc08+ccc09 29 aa8 ccc08 ccc06+ccc07+ccc08+ccc09 So only when bbxx or aaxx is alone then is sum there is bbxx or aaxx, but when this manes is with name cccxx only cccxx is in sum. Connections between cccxx and cccyy make sum cccxx+cccyy. Now I do it manually but for long sum of cccxx (once I got 18 cccxx is SUM - similar to last example with ccc06+ccc07+ccc08+ccc09) I could make mistake. €˛Joel€¯ pisze: I don't see the pattern in your data. I would need a much better description of you requirements before I could accurately complete this task. "Bartosz" wrote: Thanks for try, but it takie only one line to find konections, but the same name differend rows is thesame thing, so Your macro took only information from one row, but this macro have to look for data in all rows. I try ta add ma table onece again with infromation which I got after Your macro run. Your_macro Correct_SUM 1 bb01 bb01 bb01 2 bb01 bb01 bb01 3 ccc02 ccc02 ccc02 4 ccc02 ccc02 5 ccc06 ccc06 ccc06+ccc07 6 ccc06 ccc07 ccc06 ccc06+ccc07 7 ccc07 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 bb02 bb02 ccc01 10 ccc01 bb02 ccc01 ccc02 11 cc01 ccc03 12 ccc03 ccc03 ccc03 13 aa1 ccc03 ccc03 14 aa1 aa1 ccc03 15 aa2 ccc04 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 19 aa4 aa4 aa4 20 aa4 aa4 aa4 €˛Joel€¯ pisze: Try this Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount For RowCount = 1 To LastRow If Range("C" & RowCount) = "" And _ Range("D" & RowCount) = "" Then If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then Range("E" & RowCount) = Range("B" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If End If End If End If Next RowCount End Sub |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
Hi,
If there are the same names in different rows is mean, that this components are in one semi product, if in one row is more that one name is mean that this component is in both semi products, so this component connect two semi products. In ma last mail connections are for components 6, 10, 13, and all with last two examples. Bartosz On 24 Lis, 16:22, Joel wrote: What are the requirements for row being connected? *This must be resolved before anything alse is done. "Bartosz" wrote: Hi, Thanks for answering, what this table contains data: Column Data1 is components, Data2 semi products named aaxx Data3 and Data4 contain semi products contain name bbxx and cccxxx For simplest cases: If there is only bbxx and in any other row with bbxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx Data1 * * *Data2 * Data3 * Data4 * * * * * Correct_SUM 1 * * * * *bb01 * * * * * * * * * *bb01 2 * * * * *bb01 * * * * * * * * * *bb01 If there is only cccxx and in any other row with cccxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx 3 * * * * *ccc02 * * * * * * * * * ccc02 4 * * * * * * * * *ccc02 * * * * * ccc02 For aax in column Data2 and nothing more in data3 and Data4 the sum is aax 19 aa4 * * * * * * * * * * * * * * aa4 20 aa4 * * * * * * * * * * * * * * aa4 Of there is cccxx and in one with rows with cccxx is cccyy the sum for all rows with cccxx and cccyy is cccxx+cccyy (I add "*" to show row with connections) 5 * * * * *ccc06 * * * * * * * * * ccc06+ccc07 6* * * * * ccc06 * ccc07 * * * * * ccc06+ccc07 7 * * * * *ccc07 * * * * * * * * * ccc06+ccc07 8 * * * * * * * * *ccc07 * * * * * ccc06+ccc07 In Case when data3 and data4 contani cccxx and in one row with cccxx is bbxx then sum is only mane cccxx 9 * * * * *bb02 * * * * * * * * * *ccc01 10* * * * * * * * *ccc01 * bb02 * * * * * *ccc01 11 * * * * * * * * ccc01 * * * * * ccc01 Similar in case with aaxx in Data2 and cccxxin column Data3 or Data4 12 * * * * ccc03 * * * * * * * * * ccc03 13* * * * *aa1 * * * * * * ccc03 * * * * * ccc03 14 aa1 * * * * * * * * * * * * * * ccc03 And one with complicated situation column Data3 or data4 contain cccxx and cccyy and in the same row in column Data2 contain aaxx for both cccxx and cccyy 15 aa2 * * ccc04 * * * * * * * * * ccc04+ccc05 16 aa3 * * * * * * ccc05 * * * * * ccc04+ccc05 17 aa2 * * ccc05 * * * * * * * * * ccc04+ccc05 18 aa3 * * * * * * ccc05 * * * * * ccc04+ccc05 Another situation ccc06 join with ccc07 and ccc08 with ccc09, but i the same time ccc06 connect with aa5 which is connected with ccc08, and second ccc07-aa7-ccc09 22 aa5 * * ccc06 * * * * * * * * * ccc06+ccc07+ccc08+ccc09 23 aa6 * * ccc06 * ccc07 * * * * * ccc06+ccc07+ccc08+ccc09 24 aa7 * * ccc07 * * * * * * * * * ccc06+ccc07+ccc08+ccc09 25 aa8 * * * * * * ccc06 * * * * * ccc06+ccc07+ccc08+ccc09 26 aa5 * * ccc08 * * * * * * * * * ccc06+ccc07+ccc08+ccc09 27 aa6 * * ccc08 * ccc09 * * * * * ccc06+ccc07+ccc08+ccc09 28 aa7 * * ccc09 * * * * * * * * * ccc06+ccc07+ccc08+ccc09 29 aa8 * * * * * * ccc08 * * * * * ccc06+ccc07+ccc08+ccc09 So only when bbxx or aaxx is alone then is sum there is bbxx or aaxx, but when this manes is with name cccxx only cccxx is in sum. Connections between cccxx and cccyy make sum cccxx+cccyy. Now I do it manually but for long sum of cccxx (once I got 18 cccxx is SUM - similar to last example with ccc06+ccc07+ccc08+ccc09) I could make mistake. „Joel” pisze: I don't see the pattern in your data. *I would need a much better description of you requirements before I could accurately complete this task. "Bartosz" wrote: Thanks for try, but it takie only one line to find konections, but the same name differend rows is thesame thing, so Your macro took only information from one row, but this macro have to look for data in all rows. I try ta add ma table onece again with infromation which I got after Your macro run. * * * * * * * * * * * * *Your_macro * * *Correct_SUM 1 * * * * * * * *bb01 * * * * * *bb01 * * * * * *bb01 2 * * * * * * * *bb01 * * * * * *bb01 * * * * * *bb01 3 * * * * * * * *ccc02 * * * * * ccc02 * * * * * ccc02 4 * * * * * * * * * * * *ccc02 * * * * * * * * * ccc02 5 * * * * * * * *ccc06 * * * * * ccc06 * * * * * ccc06+ccc07 6 * * * * * * * *ccc06 * ccc07 * ccc06 * * * * * ccc06+ccc07 7 * * * * * * * *ccc07 * * * * * ccc07 * * * * * ccc06+ccc07 8 * * * * * * * * * * * *ccc07 * * * * * * * * * ccc06+ccc07 9 * * * * * * * *bb02 * * * * * *bb02 * * * * * *ccc01 10 * * * * * * * ccc01 * bb02 * *ccc01 * * * * * ccc02 11 * * * * * * * * * * * cc01 * * * * * * * * * *ccc03 12 * * * * * * * ccc03 * * * * * ccc03 * * * * * ccc03 13 * * * aa1 * * * * * * ccc03 * * * * * * * * * ccc03 14 * * * aa1 * * * * * * * * * * aa1 * * * * * * ccc03 15 * * * aa2 * * ccc04 * * * * * ccc04 * * * * * ccc04+ccc05 16 * * * aa3 * * * * * * ccc05 * * * * * * * * * ccc04+ccc05 17 * * * aa2 * * ccc05 * * * * * ccc05 * * * * * ccc04+ccc05 18 * * * aa3 * * * * * * ccc05 * * * * * * * * * ccc04+ccc05 19 * * * aa4 * * * * * * * * * * aa4 * * * * * * aa4 20 * * * aa4 * * * * * * * * * * aa4 * * * * * * aa4 „Joel” pisze: Try this Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 * *LRow = Cells(Rows.Count, ColCount).End(xlUp).Row * *If LRow LastRow Then * * * LastRow = LRow * *End If Next ColCount For RowCount = 1 To LastRow * *If Range("C" & RowCount) = "" And _ * * * Range("D" & RowCount) = "" Then * * * If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then * * * * *Range("E" & RowCount) = Range("B" & RowCount) * * * End If * *Else * * * If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ * * * * *UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then * * * * *If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then * * * * * * Range("E" & RowCount) = Range("C" & RowCount) * * * * *End If * * * * *If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then * * * * * * If Range("E" & RowCount) < "" Then * * * * * * * *Range("E" & RowCount) = Range("E" & RowCount) & "+" * * * * * * End If * * * * * * Range("E" & RowCount) = _ * * * * * * * *Range("E" & RowCount) & Range("D" & RowCount) * * * * *End If * * * Else * * * * *If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ * * * * * * UCase(Left(Range("D" & RowCount), 2)) = "BB" Then * * * * * * If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then * * * * * * * *Range("E" & RowCount) = Range("C" & RowCount) * * * * * * End If * * * * * * If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then * * * * * * * *If Range("E" & RowCount) < "" Then * * * * * * * * * Range("E" & RowCount) = Range("E" & RowCount) & "+" * * * * * * * *End If * * * * * * * *Range("E" & RowCount) = _ * * * * * * * * * Range("E" & RowCount) & Range("D" & RowCount) * * * * * * End If * * * * *End If * * * End If * *End If Next RowCount End Sub |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
The code assumes the data is on sheet 1. If not change the line below
Set DataSht = Sheets("Sheet1") I create a new worksheet called Combinations. This is a lookup table with the code to look up in column A. Column B - D are the combine codes. It was very difficult to combine the codes.. Once the codes where combined the rest of the code was pretty simple. All I do is to go down every row of your original data. I look for any code in columns B - D (all the codes on any row will have identical data in the combinations sheet). I take this code and go to the combinations worksheet and find the code in column A. then if there is data in the "CCC" column I put the data in column E of your orignal data. If there is no CCC data then I check if there is BBB data. If there isn't BB data then I take the AA data. Sub SumData() Dim ComSht As Worksheet Dim DataRange As Range 'Create Combination sheet if one doesn't exist Found = False For Each sht In Sheets If sht.Name = "Combinations" Then Found = True Exit For End If Next sht If Found = True Then Set ComSht = Sheets("Combinations") Else Set ComSht = Worksheets.Add( _ after:=Worksheets(Worksheets.Count)) ComSht.Name = "Combinations" End If Set DataSht = Sheets("Sheet1") 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = DataSht.Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount Set DataRange = DataSht.Range("B2:D" & LastRow) Call GetUniqueCodes(ComSht, DataRange) Call GetCombinations(ComSht, DataRange) With DataSht For RowCount = 2 To LastRow 'Get Code Row 'find first column with data ColNum = 0 For ColCount = 2 To 4 If .Cells(RowCount, ColCount) < "" Then ColNum = ColCount End If Next ColCount 'skip rows with no data If ColNum 0 Then code = .Cells(RowCount, ColNum) 'get row number of code on combination Sheet Set c = ComSht.Columns("A").Find(what:=code, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Can't find code") Stop Else If c.Offset(0, 3) < "" Then .Range("E" & RowCount) = c.Offset(0, 3) Else If c.Offset(0, 2) < "" Then .Range("E" & RowCount) = c.Offset(0, 2) Else .Range("E" & RowCount) = c.Offset(0, 1) End If End If End If End If Next RowCount End With End Sub Sub GetUniqueCodes(ComSht As Worksheet, DataRange As Range) With ComSht .Cells.ClearContents 'copy codes to column a Set CopyRange = Range(DataRange(1, 1), _ DataRange(DataRange.Rows.Count, 1)) CopyRange.Copy Destination:=.Range("A2") LastRow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 Set CopyRange = Range(DataRange(1, 2), _ DataRange(DataRange.Rows.Count, 2)) CopyRange.Copy Destination:=.Range("A" & NewRow) LastRow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 Set CopyRange = Range(DataRange(1, 3), _ DataRange(DataRange.Rows.Count, 3)) CopyRange.Copy Destination:=.Range("A" & NewRow) 'sort data in reverse order to get rid of blank cells LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set SortRange = .Range("A2:A" & LastRow) SortRange.Sort _ key1:=.Range("A2"), _ order1:=xlDescending 'sort data in normal order LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set SortRange = .Range("A2:A" & LastRow) SortRange.Sort _ key1:=.Range("A2"), _ order1:=xlAscending 'use advance filter to get unique items SortRange.AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=SortRange.Offset(0, 1), _ unique:=True 'delete column A so unique values are now in column A .Columns("A").Delete 'get rid of extra value left by advance filter If .Range("A2") = .Range("A3") Then .Rows(2).Delete End If End With End Sub Sub GetCombinations(ComSht As Worksheet, DataRange As Range) Dim RowRange As Range With ComSht LastRow = .Range("A" & Rows.Count).End(xlUp).Row 'Copy Unique values from column a to Row 1 Set CopyRange = .Range("A2:A" & LastRow) CopyRange.Copy .Range("B1").PasteSpecial _ Transpose:=True 'combination sheet will be a lookup table 'Colunmn A with be the lookup value (code) 'Put code in the diagnal so the code will be part of the combination For RowCount = 2 To LastRow .Cells(RowCount, RowCount) = .Range("A" & RowCount) Next RowCount For RowCount = 2 To DataRange.Rows.Count If DataRange(RowCount, 1) < "" And _ DataRange(RowCount, 2) < "" Then Code1 = DataRange(RowCount, 1) Code2 = DataRange(RowCount, 2) Row1 = .Columns("A").Find(what:=Code1, _ LookIn:=xlValues, lookat:=xlWhole).Row Row2 = .Columns("A").Find(what:=Code2, _ LookIn:=xlValues, lookat:=xlWhole).Row 'Lookup table is symetrical so row number 'and column number are identical 'put each code in the other code row .Cells(Row1, Row2) = Code2 .Cells(Row2, Row1) = Code1 End If If DataRange(RowCount, 1) < "" And _ DataRange(RowCount, 3) < "" Then Code1 = DataRange(RowCount, 1) Code3 = DataRange(RowCount, 3) Row1 = .Columns("A").Find(what:=Code1, _ LookIn:=xlValues, lookat:=xlWhole).Row Row3 = .Columns("A").Find(what:=Code3, _ LookIn:=xlValues, lookat:=xlWhole).Row 'Lookup table is symetrical so row number 'and column number are identical 'put each code in the other code row .Cells(Row1, Row3) = Code3 .Cells(Row3, Row1) = Code1 End If If DataRange(RowCount, 2) < "" And _ DataRange(RowCount, 3) < "" Then Code2 = DataRange(RowCount, 2) Code3 = DataRange(RowCount, 3) Row2 = .Columns("A").Find(what:=Code2, _ LookIn:=xlValues, lookat:=xlWhole).Row Row3 = .Columns("A").Find(what:=Code3, _ LookIn:=xlValues, lookat:=xlWhole).Row 'Lookup table is symetrical so row number 'and column number are identical 'put each code in the other code row .Cells(Row2, Row3) = Code3 .Cells(Row3, Row2) = Code2 End If Next RowCount 'fill in table with all combinations For RowCount1 = 2 To LastRow For ColCount1 = 2 To (LastRow - 1) For ColCount2 = ColCount1 To LastRow Data1 = .Cells(RowCount1, ColCount1) Data2 = .Cells(RowCount1, ColCount2) If Data1 < "" And Data2 < "" Then For RowCount2 = 2 To LastRow If RowCount1 < RowCount2 Then If .Cells(RowCount2, ColCount1) < "" Then .Cells(RowCount2, ColCount2) = Data2 End If If .Cells(RowCount2, ColCount2) < "" Then .Cells(RowCount2, ColCount1) = Data1 End If End If Next RowCount2 End If Next ColCount2 Next ColCount1 Next RowCount1 'combine codes into 3 new columns .Columns("B:D").Insert First_A_Col = 5 Last_A_Col = First_A_Col Do While UCase(Left(.Cells(1, Last_A_Col + 1), 1)) = "A" Last_A_Col = Last_A_Col + 1 Loop First_B_Col = Last_A_Col + 1 Last_B_Col = First_B_Col Do While UCase(Left(.Cells(1, Last_B_Col + 1), 1)) = "B" Last_B_Col = Last_B_Col + 1 Loop First_C_Col = Last_B_Col + 1 Last_C_Col = First_C_Col Do While UCase(Left(.Cells(1, Last_C_Col + 1), 1)) = "C" Last_C_Col = Last_C_Col + 1 Loop 'combine code into a string For RowCount = 2 To LastRow Set RowRange = .Range(.Cells(RowCount, First_A_Col), _ .Cells(RowCount, Last_A_Col)) .Range("B" & RowCount) = CombineCodes(RowRange) Set RowRange = .Range(.Cells(RowCount, First_B_Col), _ .Cells(RowCount, Last_B_Col)) .Range("C" & RowCount) = CombineCodes(RowRange) Set RowRange = .Range(.Cells(RowCount, First_C_Col), _ .Cells(RowCount, Last_C_Col)) .Range("D" & RowCount) = CombineCodes(RowRange) Next RowCount End With End Sub Function CombineCodes(Target As Range) As String CombineCodes = "" For Each cell In Target If cell < "" Then If CombineCodes = "" Then CombineCodes = cell Else CombineCodes = CombineCodes & "+" & cell End If End If Next cell End Function " wrote: Hi, If there are the same names in different rows is mean, that this components are in one semi product, if in one row is more that one name is mean that this component is in both semi products, so this component connect two semi products. In ma last mail connections are for components 6, 10, 13, and all with last two examples. Bartosz On 24 Lis, 16:22, Joel wrote: What are the requirements for row being connected? This must be resolved before anything alse is done. "Bartosz" wrote: Hi, Thanks for answering, what this table contains data: Column Data1 is components, Data2 semi products named aaxx Data3 and Data4 contain semi products contain name bbxx and cccxxx For simplest cases: If there is only bbxx and in any other row with bbxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx Data1 Data2 Data3 Data4 Correct_SUM 1 bb01 bb01 2 bb01 bb01 If there is only cccxx and in any other row with cccxx there is nothing more in column Data2, Data3 and Data4 the sum is bbxx 3 ccc02 ccc02 4 ccc02 ccc02 For aax in column Data2 and nothing more in data3 and Data4 the sum is aax 19 aa4 aa4 20 aa4 aa4 Of there is cccxx and in one with rows with cccxx is cccyy the sum for all rows with cccxx and cccyy is cccxx+cccyy (I add "*" to show row with connections) 5 ccc06 ccc06+ccc07 6* ccc06 ccc07 ccc06+ccc07 7 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 In Case when data3 and data4 contani cccxx and in one row with cccxx is bbxx then sum is only mane cccxx 9 bb02 ccc01 10* ccc01 bb02 ccc01 11 ccc01 ccc01 Similar in case with aaxx in Data2 and cccxxin column Data3 or Data4 12 ccc03 ccc03 13* aa1 ccc03 ccc03 14 aa1 ccc03 And one with complicated situation column Data3 or data4 contain cccxx and cccyy and in the same row in column Data2 contain aaxx for both cccxx and cccyy 15 aa2 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 Another situation ccc06 join with ccc07 and ccc08 with ccc09, but i the same time ccc06 connect with aa5 which is connected with ccc08, and second ccc07-aa7-ccc09 22 aa5 ccc06 ccc06+ccc07+ccc08+ccc09 23 aa6 ccc06 ccc07 ccc06+ccc07+ccc08+ccc09 24 aa7 ccc07 ccc06+ccc07+ccc08+ccc09 25 aa8 ccc06 ccc06+ccc07+ccc08+ccc09 26 aa5 ccc08 ccc06+ccc07+ccc08+ccc09 27 aa6 ccc08 ccc09 ccc06+ccc07+ccc08+ccc09 28 aa7 ccc09 ccc06+ccc07+ccc08+ccc09 29 aa8 ccc08 ccc06+ccc07+ccc08+ccc09 So only when bbxx or aaxx is alone then is sum there is bbxx or aaxx, but when this manes is with name cccxx only cccxx is in sum. Connections between cccxx and cccyy make sum cccxx+cccyy. Now I do it manually but for long sum of cccxx (once I got 18 cccxx is SUM - similar to last example with ccc06+ccc07+ccc08+ccc09) I could make mistake. €˛Joel€¯ pisze: I don't see the pattern in your data. I would need a much better description of you requirements before I could accurately complete this task. "Bartosz" wrote: Thanks for try, but it takie only one line to find konections, but the same name differend rows is thesame thing, so Your macro took only information from one row, but this macro have to look for data in all rows. I try ta add ma table onece again with infromation which I got after Your macro run. Your_macro Correct_SUM 1 bb01 bb01 bb01 2 bb01 bb01 bb01 3 ccc02 ccc02 ccc02 4 ccc02 ccc02 5 ccc06 ccc06 ccc06+ccc07 6 ccc06 ccc07 ccc06 ccc06+ccc07 7 ccc07 ccc07 ccc06+ccc07 8 ccc07 ccc06+ccc07 9 bb02 bb02 ccc01 10 ccc01 bb02 ccc01 ccc02 11 cc01 ccc03 12 ccc03 ccc03 ccc03 13 aa1 ccc03 ccc03 14 aa1 aa1 ccc03 15 aa2 ccc04 ccc04 ccc04+ccc05 16 aa3 ccc05 ccc04+ccc05 17 aa2 ccc05 ccc05 ccc04+ccc05 18 aa3 ccc05 ccc04+ccc05 19 aa4 aa4 aa4 20 aa4 aa4 aa4 €˛Joel€¯ pisze: Try this Sub SumData() 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount For RowCount = 1 To LastRow If Range("C" & RowCount) = "" And _ Range("D" & RowCount) = "" Then If UCase(Left(Range("B" & RowCount), 2)) = "AA" Then Range("E" & RowCount) = Range("B" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Or _ UCase(Left(Range("D" & RowCount), 3)) = "CCC" Then If UCase(Left(Range("C" & RowCount), 3)) = "CCC" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 3)) = "CC" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If Else If UCase(Left(Range("C" & RowCount), 2)) = "BB" Or _ UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If UCase(Left(Range("C" & RowCount), 2)) = "BB" Then Range("E" & RowCount) = Range("C" & RowCount) End If If UCase(Left(Range("D" & RowCount), 2)) = "BB" Then If Range("E" & RowCount) < "" Then Range("E" & RowCount) = Range("E" & RowCount) & "+" End If Range("E" & RowCount) = _ Range("E" & RowCount) & Range("D" & RowCount) End If End If End If End If Next RowCount End Sub |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Special sum of texts
Thanks!
Works great!!! Best Regards, Bartosz €˛Joel€¯ pisze: The code assumes the data is on sheet 1. If not change the line below Set DataSht = Sheets("Sheet1") I create a new worksheet called Combinations. This is a lookup table with the code to look up in column A. Column B - D are the combine codes. It was very difficult to combine the codes.. Once the codes where combined the rest of the code was pretty simple. All I do is to go down every row of your original data. I look for any code in columns B - D (all the codes on any row will have identical data in the combinations sheet). I take this code and go to the combinations worksheet and find the code in column A. then if there is data in the "CCC" column I put the data in column E of your orignal data. If there is no CCC data then I check if there is BBB data. If there isn't BB data then I take the AA data. Sub SumData() Dim ComSht As Worksheet Dim DataRange As Range 'Create Combination sheet if one doesn't exist Found = False For Each sht In Sheets If sht.Name = "Combinations" Then Found = True Exit For End If Next sht If Found = True Then Set ComSht = Sheets("Combinations") Else Set ComSht = Worksheets.Add( _ after:=Worksheets(Worksheets.Count)) ComSht.Name = "Combinations" End If Set DataSht = Sheets("Sheet1") 'Get Last row LastRow = 0 For ColCount = 2 To 4 LRow = DataSht.Cells(Rows.Count, ColCount).End(xlUp).Row If LRow LastRow Then LastRow = LRow End If Next ColCount Set DataRange = DataSht.Range("B2:D" & LastRow) Call GetUniqueCodes(ComSht, DataRange) Call GetCombinations(ComSht, DataRange) With DataSht For RowCount = 2 To LastRow 'Get Code Row 'find first column with data ColNum = 0 For ColCount = 2 To 4 If .Cells(RowCount, ColCount) < "" Then ColNum = ColCount End If Next ColCount 'skip rows with no data If ColNum 0 Then code = .Cells(RowCount, ColNum) 'get row number of code on combination Sheet Set c = ComSht.Columns("A").Find(what:=code, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Can't find code") Stop Else If c.Offset(0, 3) < "" Then .Range("E" & RowCount) = c.Offset(0, 3) Else If c.Offset(0, 2) < "" Then .Range("E" & RowCount) = c.Offset(0, 2) Else .Range("E" & RowCount) = c.Offset(0, 1) End If End If End If End If Next RowCount End With End Sub Sub GetUniqueCodes(ComSht As Worksheet, DataRange As Range) With ComSht .Cells.ClearContents 'copy codes to column a Set CopyRange = Range(DataRange(1, 1), _ DataRange(DataRange.Rows.Count, 1)) CopyRange.Copy Destination:=.Range("A2") LastRow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 Set CopyRange = Range(DataRange(1, 2), _ DataRange(DataRange.Rows.Count, 2)) CopyRange.Copy Destination:=.Range("A" & NewRow) LastRow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 Set CopyRange = Range(DataRange(1, 3), _ DataRange(DataRange.Rows.Count, 3)) CopyRange.Copy Destination:=.Range("A" & NewRow) 'sort data in reverse order to get rid of blank cells LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set SortRange = .Range("A2:A" & LastRow) SortRange.Sort _ key1:=.Range("A2"), _ order1:=xlDescending 'sort data in normal order LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set SortRange = .Range("A2:A" & LastRow) SortRange.Sort _ key1:=.Range("A2"), _ order1:=xlAscending 'use advance filter to get unique items SortRange.AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=SortRange.Offset(0, 1), _ unique:=True 'delete column A so unique values are now in column A .Columns("A").Delete 'get rid of extra value left by advance filter If .Range("A2") = .Range("A3") Then .Rows(2).Delete End If End With End Sub Sub GetCombinations(ComSht As Worksheet, DataRange As Range) Dim RowRange As Range With ComSht LastRow = .Range("A" & Rows.Count).End(xlUp).Row 'Copy Unique values from column a to Row 1 Set CopyRange = .Range("A2:A" & LastRow) CopyRange.Copy .Range("B1").PasteSpecial _ Transpose:=True 'combination sheet will be a lookup table 'Colunmn A with be the lookup value (code) 'Put code in the diagnal so the code will be part of the combination For RowCount = 2 To LastRow .Cells(RowCount, RowCount) = .Range("A" & RowCount) Next RowCount For RowCount = 2 To DataRange.Rows.Count If DataRange(RowCount, 1) < "" And _ DataRange(RowCount, 2) < "" Then Code1 = DataRange(RowCount, 1) Code2 = DataRange(RowCount, 2) Row1 = .Columns("A").Find(what:=Code1, _ LookIn:=xlValues, lookat:=xlWhole).Row Row2 = .Columns("A").Find(what:=Code2, _ LookIn:=xlValues, lookat:=xlWhole).Row 'Lookup table is symetrical so row number 'and column number are identical 'put each code in the other code row .Cells(Row1, Row2) = Code2 .Cells(Row2, Row1) = Code1 End If If DataRange(RowCount, 1) < "" And _ DataRange(RowCount, 3) < "" Then Code1 = DataRange(RowCount, 1) Code3 = DataRange(RowCount, 3) Row1 = .Columns("A").Find(what:=Code1, _ LookIn:=xlValues, lookat:=xlWhole).Row Row3 = .Columns("A").Find(what:=Code3, _ LookIn:=xlValues, lookat:=xlWhole).Row 'Lookup table is symetrical so row number 'and column number are identical 'put each code in the other code row .Cells(Row1, Row3) = Code3 .Cells(Row3, Row1) = Code1 End If If DataRange(RowCount, 2) < "" And _ DataRange(RowCount, 3) < "" Then Code2 = DataRange(RowCount, 2) Code3 = DataRange(RowCount, 3) Row2 = .Columns("A").Find(what:=Code2, _ LookIn:=xlValues, lookat:=xlWhole).Row Row3 = .Columns("A").Find(what:=Code3, _ LookIn:=xlValues, lookat:=xlWhole).Row 'Lookup table is symetrical so row number 'and column number are identical 'put each code in the other code row .Cells(Row2, Row3) = Code3 .Cells(Row3, Row2) = Code2 End If Next RowCount 'fill in table with all combinations For RowCount1 = 2 To LastRow For ColCount1 = 2 To (LastRow - 1) For ColCount2 = ColCount1 To LastRow Data1 = .Cells(RowCount1, ColCount1) Data2 = .Cells(RowCount1, ColCount2) If Data1 < "" And Data2 < "" Then For RowCount2 = 2 To LastRow If RowCount1 < RowCount2 Then If .Cells(RowCount2, ColCount1) < "" Then .Cells(RowCount2, ColCount2) = Data2 End If If .Cells(RowCount2, ColCount2) < "" Then .Cells(RowCount2, ColCount1) = Data1 End If End If Next RowCount2 End If Next ColCount2 Next ColCount1 Next RowCount1 'combine codes into 3 new columns .Columns("B:D").Insert First_A_Col = 5 Last_A_Col = First_A_Col Do While UCase(Left(.Cells(1, Last_A_Col + 1), 1)) = "A" Last_A_Col = Last_A_Col + 1 Loop First_B_Col = Last_A_Col + 1 Last_B_Col = First_B_Col Do While UCase(Left(.Cells(1, Last_B_Col + 1), 1)) = "B" Last_B_Col = Last_B_Col + 1 Loop First_C_Col = Last_B_Col + 1 Last_C_Col = First_C_Col Do While UCase(Left(.Cells(1, Last_C_Col + 1), 1)) = "C" Last_C_Col = Last_C_Col + 1 Loop 'combine code into a string For RowCount = 2 To LastRow Set RowRange = .Range(.Cells(RowCount, First_A_Col), _ .Cells(RowCount, Last_A_Col)) .Range("B" & RowCount) = CombineCodes(RowRange) Set RowRange = .Range(.Cells(RowCount, First_B_Col), _ .Cells(RowCount, Last_B_Col)) .Range("C" & RowCount) = CombineCodes(RowRange) Set RowRange = .Range(.Cells(RowCount, First_C_Col), _ .Cells(RowCount, Last_C_Col)) .Range("D" & RowCount) = CombineCodes(RowRange) Next RowCount End With End Sub Function CombineCodes(Target As Range) As String CombineCodes = "" For Each cell In Target If cell < "" Then If CombineCodes = "" Then CombineCodes = cell Else CombineCodes = CombineCodes & "+" & cell End If End If Next cell End Function " wrote: Hi, If there are the same names in different rows is mean, that this components are in one semi product, if in one row is more that one name is mean that this component is in both semi products, so this |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Counting texts | Excel Discussion (Misc queries) | |||
| SUMIF for texts | Excel Worksheet Functions | |||
| Concatenation 2 Texts | Excel Discussion (Misc queries) | |||
| Combo Box Texts | Excel Discussion (Misc queries) | |||
| Using Texts in Cells | Excel Discussion (Misc queries) | |||
Linear Mode
