Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Multiple Macros at once different output
Hi All,
I am currently counting colored cells, some are merged being counted as one. I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I have a seperate macro to run for each seperate color in each of the 26 ranges. Each result is displayed in a MsgBox. I would like to condense these macros to run in groups by color. For instance count all of the yellow cells within the 26 different ranges. Then instead of a MsgBox I would like to results on a seperate sheet somehow. This way I can preformat the results sheet to indicate the range then the answer can go in the cell next to it. Given a simple sample destination I can modify it to my spefic settings. I am not fluent in macro so some guidance is appreciated. Below are two of the macros for reference: Option Explicit Sub zwCoopReinYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("B40:E58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ _______________ Option Explicit Sub zyVisualYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("H32:K58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Visual Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ ___________ Thanks SO much Clint |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Multiple Macros at once different output
One clarification... I need each a total for each specific range not a grand
total. Thanks again, Clint "Whois Clinton" wrote: Hi All, I am currently counting colored cells, some are merged being counted as one. I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I have a seperate macro to run for each seperate color in each of the 26 ranges. Each result is displayed in a MsgBox. I would like to condense these macros to run in groups by color. For instance count all of the yellow cells within the 26 different ranges. Then instead of a MsgBox I would like to results on a seperate sheet somehow. This way I can preformat the results sheet to indicate the range then the answer can go in the cell next to it. Given a simple sample destination I can modify it to my spefic settings. I am not fluent in macro so some guidance is appreciated. Below are two of the macros for reference: Option Explicit Sub zwCoopReinYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("B40:E58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ _______________ Option Explicit Sub zyVisualYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("H32:K58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Visual Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ ___________ Thanks SO much Clint |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Multiple Macros at once different output
Hello again,
If I follow you want to return fills in upt to 5 areas. Following should get them all in one go. Not sure how you want to report the info, as written look at the immediate window, Ctrl-g Sub GetFills() ' only count once per merged area Dim x As Long, i As Long, a As Long Dim redCells As Long Dim yellowCells As Long Dim rng As Range, aR As Range, c As Range Set rng = Range("B40:E58, H32:K58") ' add more areas here ' address length MUST be <256 ReDim aIdx(1 To rng.Areas.Count, 1 To 56) As Long For Each aR In rng.Areas a = a + 1 For Each c In aR x = c.Interior.ColorIndex If x = 0 Then If c.MergeCells Then If c.Address = c.MergeArea(1, 1).Address Then aIdx(a, x) = aIdx(a, x) + 1 End If Else aIdx(a, x) = aIdx(a, x) + 1 End If End If Next Next For a = 1 To rng.Areas.Count Debug.Print rng.Areas(1).Address(0, 0) For i = 1 To 56 If aIdx(a, i) Then Debug.Print a, i, aIdx(a, i) End If Next Next End Sub Regards, Peter T "Whois Clinton" wrote in message ... Hi All, I am currently counting colored cells, some are merged being counted as one. I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I have a seperate macro to run for each seperate color in each of the 26 ranges. Each result is displayed in a MsgBox. I would like to condense these macros to run in groups by color. For instance count all of the yellow cells within the 26 different ranges. Then instead of a MsgBox I would like to results on a seperate sheet somehow. This way I can preformat the results sheet to indicate the range then the answer can go in the cell next to it. Given a simple sample destination I can modify it to my spefic settings. I am not fluent in macro so some guidance is appreciated. Below are two of the macros for reference: Option Explicit Sub zwCoopReinYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("B40:E58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ _______________ Option Explicit Sub zyVisualYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("H32:K58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Visual Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ ___________ Thanks SO much Clint |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Multiple Macros at once different output
Thanks, this seems very close to what I am aiming for. I want to count all
one color within the ranges. So it easy enough to remove one set of colors in the code you gave me. However, I need it specified to only count the specific colors in each count. For instance, I need to know how many red cells in ranges ("B40:E58, H32:K58" etc.) and how many yellow in the same ranges. I also would like the results on a new page I will set and format. If we use "Sheet2" Cells (A2:Z2) for an easy destination reference I can customize the exact destinations later. Maybe i just am not Debugging Print line correctly? Thanks for your time, Clint "Peter T" wrote: Hello again, If I follow you want to return fills in upt to 5 areas. Following should get them all in one go. Not sure how you want to report the info, as written look at the immediate window, Ctrl-g Sub GetFills() ' only count once per merged area Dim x As Long, i As Long, a As Long Dim redCells As Long Dim yellowCells As Long Dim rng As Range, aR As Range, c As Range Set rng = Range("B40:E58, H32:K58") ' add more areas here ' address length MUST be <256 ReDim aIdx(1 To rng.Areas.Count, 1 To 56) As Long For Each aR In rng.Areas a = a + 1 For Each c In aR x = c.Interior.ColorIndex If x = 0 Then If c.MergeCells Then If c.Address = c.MergeArea(1, 1).Address Then aIdx(a, x) = aIdx(a, x) + 1 End If Else aIdx(a, x) = aIdx(a, x) + 1 End If End If Next Next For a = 1 To rng.Areas.Count Debug.Print rng.Areas(1).Address(0, 0) For i = 1 To 56 If aIdx(a, i) Then Debug.Print a, i, aIdx(a, i) End If Next Next End Sub Regards, Peter T "Whois Clinton" wrote in message ... Hi All, I am currently counting colored cells, some are merged being counted as one. I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I have a seperate macro to run for each seperate color in each of the 26 ranges. Each result is displayed in a MsgBox. I would like to condense these macros to run in groups by color. For instance count all of the yellow cells within the 26 different ranges. Then instead of a MsgBox I would like to results on a seperate sheet somehow. This way I can preformat the results sheet to indicate the range then the answer can go in the cell next to it. Given a simple sample destination I can modify it to my spefic settings. I am not fluent in macro so some guidance is appreciated. Below are two of the macros for reference: Option Explicit Sub zwCoopReinYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("B40:E58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ _______________ Option Explicit Sub zyVisualYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("H32:K58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Visual Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ ___________ Thanks SO much Clint |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Multiple Macros at once different output
No need to "remove one set of colors", just get the ones you want to know
about from the array "aIdx", eg After the debug code (comment or remove if you want) add the following Dim wsReport As Worksheet Dim arrReqdClrs, arrClrNames ' variants Set ws = Worksheets("Sheet2") ' << CHANGE arrReqdClrs = Array(3, 6) arrClrNames = Array("Red", "Yellow") ws.Range("A1") = ActiveSheet.Name For a = 1 To rng.Areas.Count ws.Cells(1, a + 1) = rng.Areas(a).Address(0, 0) Next For i = 0 To UBound(arrReqdClrs) ws.Cells(i + 2, 1) = arrClrNames(i) For a = 1 To rng.Areas.Count ws.Cells(i + 2, a + 1) = aidx(a, arrReqdClrs(i)) Next Next Add more ColorIndexes and names to the arrays arrReqdClrs & arrClrNames as you're interested in (ensure each array has same qty of elements). Regards, Peter T "Whois Clinton" wrote in message ... Thanks, this seems very close to what I am aiming for. I want to count all one color within the ranges. So it easy enough to remove one set of colors in the code you gave me. However, I need it specified to only count the specific colors in each count. For instance, I need to know how many red cells in ranges ("B40:E58, H32:K58" etc.) and how many yellow in the same ranges. I also would like the results on a new page I will set and format. If we use "Sheet2" Cells (A2:Z2) for an easy destination reference I can customize the exact destinations later. Maybe i just am not Debugging Print line correctly? Thanks for your time, Clint "Peter T" wrote: Hello again, If I follow you want to return fills in upt to 5 areas. Following should get them all in one go. Not sure how you want to report the info, as written look at the immediate window, Ctrl-g Sub GetFills() ' only count once per merged area Dim x As Long, i As Long, a As Long Dim redCells As Long Dim yellowCells As Long Dim rng As Range, aR As Range, c As Range Set rng = Range("B40:E58, H32:K58") ' add more areas here ' address length MUST be <256 ReDim aIdx(1 To rng.Areas.Count, 1 To 56) As Long For Each aR In rng.Areas a = a + 1 For Each c In aR x = c.Interior.ColorIndex If x = 0 Then If c.MergeCells Then If c.Address = c.MergeArea(1, 1).Address Then aIdx(a, x) = aIdx(a, x) + 1 End If Else aIdx(a, x) = aIdx(a, x) + 1 End If End If Next Next For a = 1 To rng.Areas.Count Debug.Print rng.Areas(1).Address(0, 0) For i = 1 To 56 If aIdx(a, i) Then Debug.Print a, i, aIdx(a, i) End If Next Next End Sub Regards, Peter T "Whois Clinton" wrote in message ... Hi All, I am currently counting colored cells, some are merged being counted as one. I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I have a seperate macro to run for each seperate color in each of the 26 ranges. Each result is displayed in a MsgBox. I would like to condense these macros to run in groups by color. For instance count all of the yellow cells within the 26 different ranges. Then instead of a MsgBox I would like to results on a seperate sheet somehow. This way I can preformat the results sheet to indicate the range then the answer can go in the cell next to it. Given a simple sample destination I can modify it to my spefic settings. I am not fluent in macro so some guidance is appreciated. Below are two of the macros for reference: Option Explicit Sub zwCoopReinYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("B40:E58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ _______________ Option Explicit Sub zyVisualYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("H32:K58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Visual Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ ___________ Thanks SO much Clint |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Multiple Macros at once different output
AWESOME Thank you so much. You have saved me (and my eyes) days of
counting!!! Clint "Peter T" wrote: No need to "remove one set of colors", just get the ones you want to know about from the array "aIdx", eg After the debug code (comment or remove if you want) add the following Dim wsReport As Worksheet Dim arrReqdClrs, arrClrNames ' variants Set ws = Worksheets("Sheet2") ' << CHANGE arrReqdClrs = Array(3, 6) arrClrNames = Array("Red", "Yellow") ws.Range("A1") = ActiveSheet.Name For a = 1 To rng.Areas.Count ws.Cells(1, a + 1) = rng.Areas(a).Address(0, 0) Next For i = 0 To UBound(arrReqdClrs) ws.Cells(i + 2, 1) = arrClrNames(i) For a = 1 To rng.Areas.Count ws.Cells(i + 2, a + 1) = aidx(a, arrReqdClrs(i)) Next Next Add more ColorIndexes and names to the arrays arrReqdClrs & arrClrNames as you're interested in (ensure each array has same qty of elements). Regards, Peter T "Whois Clinton" wrote in message ... Thanks, this seems very close to what I am aiming for. I want to count all one color within the ranges. So it easy enough to remove one set of colors in the code you gave me. However, I need it specified to only count the specific colors in each count. For instance, I need to know how many red cells in ranges ("B40:E58, H32:K58" etc.) and how many yellow in the same ranges. I also would like the results on a new page I will set and format. If we use "Sheet2" Cells (A2:Z2) for an easy destination reference I can customize the exact destinations later. Maybe i just am not Debugging Print line correctly? Thanks for your time, Clint "Peter T" wrote: Hello again, If I follow you want to return fills in upt to 5 areas. Following should get them all in one go. Not sure how you want to report the info, as written look at the immediate window, Ctrl-g Sub GetFills() ' only count once per merged area Dim x As Long, i As Long, a As Long Dim redCells As Long Dim yellowCells As Long Dim rng As Range, aR As Range, c As Range Set rng = Range("B40:E58, H32:K58") ' add more areas here ' address length MUST be <256 ReDim aIdx(1 To rng.Areas.Count, 1 To 56) As Long For Each aR In rng.Areas a = a + 1 For Each c In aR x = c.Interior.ColorIndex If x = 0 Then If c.MergeCells Then If c.Address = c.MergeArea(1, 1).Address Then aIdx(a, x) = aIdx(a, x) + 1 End If Else aIdx(a, x) = aIdx(a, x) + 1 End If End If Next Next For a = 1 To rng.Areas.Count Debug.Print rng.Areas(1).Address(0, 0) For i = 1 To 56 If aIdx(a, i) Then Debug.Print a, i, aIdx(a, i) End If Next Next End Sub Regards, Peter T "Whois Clinton" wrote in message ... Hi All, I am currently counting colored cells, some are merged being counted as one. I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I have a seperate macro to run for each seperate color in each of the 26 ranges. Each result is displayed in a MsgBox. I would like to condense these macros to run in groups by color. For instance count all of the yellow cells within the 26 different ranges. Then instead of a MsgBox I would like to results on a seperate sheet somehow. This way I can preformat the results sheet to indicate the range then the answer can go in the cell next to it. Given a simple sample destination I can modify it to my spefic settings. I am not fluent in macro so some guidance is appreciated. Below are two of the macros for reference: Option Explicit Sub zwCoopReinYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("B40:E58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ _______________ Option Explicit Sub zyVisualYellow() Dim c As Range Dim MyRange As Range Dim arrRng() As String Dim yellowCells As Long Dim N As Long Dim M As Long Set MyRange = Range("H32:K58") ReDim arrRng(1 To MyRange.Count) For Each c In MyRange If c.Interior.ColorIndex = 6 Then If c.MergeCells Then N = N + 1 For M = 1 To N If c.MergeArea.Address = arrRng(M) Then Exit For End If Next If M N Then yellowCells = yellowCells + 1 arrRng(N) = c.MergeArea.Address End If Else yellowCells = yellowCells + 1 End If End If Next MsgBox yellowCells, vbOKOnly, "Visual Yellow" Set c = Nothing Set MyRange = Nothing End Sub __________________________________________________ ___________ Thanks SO much Clint |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Four macros, one main output | Excel Worksheet Functions | |||
Multiple input and output results | Excel Discussion (Misc queries) | |||
Multiple inputs one output | Excel Discussion (Misc queries) | |||
Can macros output to a cell selected prior to running it? | Excel Worksheet Functions | |||
how do i have multiple inputs and 1 output | Excel Programming |