I have an excel file, starting from A to GM .
In row 3, I have columns headings, as an example, as follows:
Sub bar Sub Sim bar Sub IV bar
1 1 0 1 1 0 0 4
1 1 1 0 0 1 1 0
0 1 0 1 1 1 0 1
0 1 0 1 3 0 0 0
0 1 1 0 1 1 1 1
0 0 0 0 0 0 1 1
0 0 0 1 1 0 1 1
1 0 0 1 1 1 0 1
1 1 1 1 1 0 0 1
1 0 0 1 0 1 0 1
1 4 0 0 1 1 0 0
I have several column heading ( sub, bar, sim,...)
I want to select the columns with a specific heading column, say "bar" and see them in sheet 2 as follows:
bar bar bar
1 1 4
1 0 0
1 1 1
1 3 0
1 1 1
0 0 1
0 1 1
0 1 1
1 1 1
0 0 1
4 1 0
I know how to do it using vlookup and filter. However, I want to do using a simple VBA, if it is possible. Is it possible?
you could try this:
Sub main()
Worksheets("Sheet1").Range("A3").CurrentRegion.Copy Destination:=Worksheets("Sheet2").Range("A3") 'copy data from sheet1 to sheet2
With Worksheets("Sheet2").Range("A3:GM3") 'reference sheet2 headings
.Replace what:="bar", lookat:=xlWhole, replacement:="" ' replace wanted heading with blank
.SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True ' hide blank headings columns
.SpecialCells(xlCellTypeVisible).EntireColumn.Delete ' delete visible heading columns
.EntireColumn.Hidden = False ' unhide hidden columns
.Value = "bar" 'write wanted heading back
End With
End Sub
just change "Sheet1" and "Sheet2" to your actual sheet names
Related
I want to add 0 or 1 as numbers (randomly) in a lot of cells (in different rows and columns). For example:
0 1 1 1 0 0 0 0
1 1 0 0 0 1 1 0
But I want those numbers be added up to five times in a row. For example: if the row has 10 cells which the random numbers will go, I don't want the 1 or 0 to be added a sixth time so I am looking to something like this: 0 1 1 1 0 1 1 0 0 0
Based on your latest comment, the following code would work:
Sub test()
Dim rw As Range
For Each rw In Range("A1:J116").Rows
create_binary rw, 5
Next
End Sub
Sub create_binary(rng As Range, one_count As Long)
With rng
.ClearContents
Do Until Application.WorksheetFunction.Sum(.Cells) = one_count
.Cells(Int(.Count * Rnd + 1)) = 1
Loop
.SpecialCells(xlCellTypeBlanks).Value = 0
End With
End Sub
It contains a subroutine called create_binary which needs two parameters:
The cells to write to (rng)
The total value you want those cells to reach (one_count)
I'm trying to run a loop on 3 variables, where order doesn't matter.
The code I've tried first is the following, where nx runs through the rows, and limit is the last row of my database:
Do While n3 <= limit
Do While n2 <= limit
Do While n1 <= limit
Call Output
n1 = n1 + 1
Loop
Call Output
n2 = n2 + 1
n1 = n0
Loop
Call Output
n3 = n3 + 1
n2 = n0
n1 = n0
Loop
This allows me to test every possibility, but it does also repeat the same combination several times, which increases the runtime. This will make the code unusable if I plan on testing, let's say, 20 variables.
Any tips on how to optimize this loop?
Thank you.
Based on your comment that you do not want permutations of a given combination. Lets say we are mixing paint. We have five different colors:
white
black
yellow
blue
green
We want to mix all possible combinations of three cans, but once we have mixed
white,blue,green
we don't need any of these:
white,green,bluegreen,white,bluegreen,blue,whiteblue,green,whiteblue,white,green
because they all result in the same light teal.
First we run the loops in this staggered fashion:
Sub MixPaint()
Dim arr(1 To 5) As String
Dim i As Long, j As Long, k As Long, LL As Long
arr(1) = "white"
arr(2) = "black"
arr(3) = "blue"
arr(4) = "green"
arr(5) = "yellow"
LL = 1
For i = 1 To 3
For j = i + 1 To 4
For k = j + 1 To 5
Cells(LL, 1) = arr(i) & ":" & arr(j) & ":" & arr(k)
LL = LL + 1
Next k
Next j
Next i
End Sub
This gets us:
This removes the permuted duplicates, but it also removes combinations like:
blue,blue,white
To get these back we adjust the loops slightly:
Sub MixPaint2()
Dim arr(1 To 5) As String
Dim i As Long, j As Long, k As Long, LL As Long
arr(1) = "white"
arr(2) = "black"
arr(3) = "blue"
arr(4) = "green"
arr(5) = "yellow"
LL = 1
For i = 1 To 5
For j = i To 5
For k = j To 5
Cells(LL, 5) = arr(i) & ":" & arr(j) & ":" & arr(k)
LL = LL + 1
Next k
Next j
Next i
End Sub
Now we have:
Which may be what you are after.
If you need to loop through a table I would loop throw the rows and columns of the table, with a double for o double while, through all the cells, to avoid repeating combinations. According to your while approach this would be:
Do While row <= rowLimit
Do While col <= colLimit
'with if conditions you can make your operations
col = col +1
Loop
row = row + 1
Loop
If you need to loop through the rows independently, you dont need to the whiles to be nested, and each while can loop its row independently. If n1, n2, and n3 have dependencies with each other, you would need to explain those, so that their relation can be taken into account to exclude determined combinations from the nested loop.
However, if the order of the combination matters as far as I checked there are no combinations repeated in your loop.
This is the log of your loop for example for n1=n2=n3 and limit =2
1 0 0
0 1 0
0 0 0
1 0 0
2 0 0
3 0 0
0 1 0
1 1 0
2 1 0
3 1 0
0 2 0
1 2 0
2 2 0
3 2 0
0 3 0
0 0 1
1 0 1
2 0 1
3 0 1
0 1 1
1 1 1
2 1 1
3 1 1
0 2 1
1 2 1
2 2 1
3 2 1
0 3 1
0 0 2
1 0 2
2 0 2
3 0 2
0 1 2
1 1 2
2 1 2
3 1 2
0 2 2
1 2 2
2 2 2
3 2 2
0 3 2
But if the order does not matter and you need to loop through every n, up to the row limit, with no n value reptition, then the while loop can be independent so do not need to be nested.
So I am not sure if I have answered your question or I am missing something.
Hope that helps anyhow
I have an excel sheet with the following format
a 2 3 4 0 0 0 0 0
a 2 5 6 7 0 0 0 0
a 4 5 9 0 0 0 0 0
b 5 5 9 0 0 0 0 0
b 1 1 1 1 1 1 1 1
I want to end up with something like this
a 2
a 3
a 4
a 2
a 5
a 6
a 7
a 4 .....
b 1
b 1
b 1 ....
Check out my unpivot add-in (just add a header row that you can remove afterwards). It will return the data in the format you need.
Try this
Sub move()
Dim cell As Range, _
found As Range
Dim letter As String
Set cell = Range("B1")
Set found = Range("A:A").Find("*", Range("A1"), searchdirection:=xlPrevious).Offset(2, 0)
Do While (cell.Value <> "")
letter = cell.Offset(0, -1).Value
Do While (cell.Value <> 0)
found.Value = letter
found.Offset(0, 1).Value = cell.Value
Set cell = cell.Offset(0, 1)
Set found = found.Offset(1, 0)
Loop
Set cell = Cells(cell.Row + 1, 2)
Loop
End Sub
I was able to do this pretty quickly with a combination of concatenation and de-concatenation and a formula from http://www.cpearson.com/excel/TableToColumn.aspx
=$A1&","&B1
=OFFSET($K$1:$R$5,TRUNC((ROW()-ROW($U$1))/COLUMNS($K$1:$R$5),0),MOD(ROW()-ROW($U$1),COLUMNS($K$1:$R$5)),1,1)
=LEFT(U1,FIND(",",U1,1)-1)
=RIGHT(U1,FIND(",",U1,1)-1)
Good Luck.
In an another post, the user Excellll provided a macro address the aforementioned question.
I have a worksheet which has data as below:
A B C
abc,def,ghi,jkl 1,2,3 a1,e3,h5,j8
The following solution turns it into
abc 1 a1
abc 2 a1
abc 3 a1
abc 1 e3
abc 2 e3
abc 3 h5
However, I wanted to know how the macro can be modified as the number of columns of data grow from 3 columns of data to 10 columns of data.
I tried modifying the macro a number of times based upon the patterns in the code that I saw, but I kept getting an error.
I am a fan of recursion but only if I believe it provides the simpliest solution. I do not believe it is appropriate for this problem.
In the original question, UJ9 had:
Column A B C
Row 1 abc,def,ghi,jkl 1,2,3 a1,e3,h5,j8
and wanted:
Column A B C
Row 1 abc 1 a1
Row 2 abc 2 a1
Row 3 abc 3 a1
Row 4 abc 1 e3
Row 5 abc 2 e3
Row 6 abc 3 h5
:
Row 48 jkl 3 j8
user1657410 wants the same but with 10 columns.
The solutions for the original problem use three (one per column) nested for-loops. Adapting those solutions for ten nested for-loops is possible but not an easy implementation. Let us consider the principle behind those solutions and then look for a different implementation strategy.
If we index the values in each column we get:
Column A B C
Row 1 abc,def,ghi,jkl 1,2,3 a1,e3,h5,j8
Index 0 1 2 3 0 1 2 0 1 2 3
What the solutions do is generate every combination of index: 000 001 002 003 010 011 012 013 020 021 021 023 100 ... 323 and use the digits to select the appropriate substring from the appropriate string.
To adapt this approach for a larger number of columns we need to switch from nested for-loops to arrays with one entry per column. One array hold the maximum value of the index for the column and the other holds the currently selected index. The initial state would be something like:
Column A B C D E F G H I J
Maximum index array 4 3 4 4 3 2 6 3 4 2
Current index array 0 0 0 0 0 0 0 0 0 0
We now need a loop that will increment the Current index array like a speedometer except each column has its own maximum. That is, we want to add one to the rightmost element of the Current index array unless it is already at its maximum value. If it is at its maximum value, it is reset to zero and the next column to the left is incremented unless it is at its maximum value. This continues until the loop wants to increment the leftmost index past its maximum value. That is, we need a loop which will set the Current index array to the following values:
Column A B C D E F G H I J
Maximum index array 4 3 4 4 3 2 6 3 4 2
Current index array 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 0 0 2
0 0 0 0 0 0 0 0 1 0
0 0 0 0 0 0 0 0 1 1
0 0 0 0 0 0 0 0 1 2
0 0 0 0 0 0 0 0 2 0
0 0 0 0 0 0 0 0 2 1
0 0 0 0 0 0 0 0 2 2
0 0 0 0 0 0 0 0 3 0
0 0 0 0 0 0 0 0 3 1
0 0 0 0 0 0 0 0 3 2
0 0 0 0 0 0 0 1 0 0
: :
4 3 4 4 3 2 6 3 4 2
For each different value of the Current index array, you select the appropriate substring from each column and generate a row containing the substrings.
Before we go any further, are you sure you want to generate a row per combination of sub-string? With the maximum index values I selected for my example, you would get 2,520,000 rows.
The code below assumes the source row is row 1. It outputs the generated rows starting at row 3. This code generates a table like the one above so you can properly understand how the code works. Below this code are instructions to amend it to output substrings. The code adjusts to the number of columns in the source row. The code does not check that your version of Excel can support the number of rows generated.
Sub Combinations()
Dim ColCrnt As Long
Dim ColMax As Long
Dim IndexCrnt() As Long
Dim IndexMax() As Long
Dim RowCrnt As Long
Dim SubStrings() As String
Dim TimeStart As Single
TimeStart = Timer
With Worksheets("Combinations")
' Use row 1 as the source row. Find last used column.
ColMax = .Cells(1, Columns.Count).End(xlToLeft).Column
' Size Index arrays according to number of columns
' Use one based arrays so entry number matches column number
ReDim IndexCrnt(1 To ColMax)
ReDim IndexMax(1 To ColMax)
' Initialise arrays
For ColCrnt = 1 To ColMax
SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
' SubStrings is a zero-based array with one entry
' per comma separated value.
IndexMax(ColCrnt) = UBound(SubStrings)
IndexCrnt(ColCrnt) = 0
Next
RowCrnt = 3 ' Output generated values starting at row 3
Do While True
' Use IndexCrnt() here.
' For this version I output the index values
For ColCrnt = 1 To ColMax
' This will generate an error if RowCrnt exceeds the maximum number
' of columns for your version of Excel.
.Cells(RowCrnt, ColCrnt).Value = IndexCrnt(ColCrnt)
Next
RowCrnt = RowCrnt + 1
' Increment values in IndexCrnt() from right to left
For ColCrnt = ColMax To 1 Step -1
If IndexCrnt(ColCrnt) < IndexMax(ColCrnt) Then
' This column's current index can be incremented
IndexCrnt(ColCrnt) = IndexCrnt(ColCrnt) + 1
Exit For
End If
If ColCrnt = 1 Then
' Leftmost column has overflowed.
' All combinations of index value have been generated.
Exit Do
End If
IndexCrnt(ColCrnt) = 0
' Loop to increment next column
Next
Loop
End With
Debug.Print Format(Timer - TimeStart, "#,###.##")
End Sub
If you are happy that you understand the above code, replace:
' For this version I output the index values
For ColCrnt = 1 To ColMax
.Cells(RowCrnt, ColCrnt).Value = IndexCrnt(ColCrnt)
Next
by:
For ColCrnt = 1 To ColMax
SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
.Cells(RowCrnt, ColCrnt).Value = SubStrings(IndexCrnt(ColCrnt))
Next
This revised code output the appropriate substring for each combination but it will be slow with large numbers of combination because it extracts the required substring from the source cell for every generated row. For example, it generates 27,648 rows in 12.66 seconds. The code below takes 9.15 seconds but uses a more advanced technique.
Step 1, replace:
Dim SubStrings() As String
by:
Dim SubStrings() As Variant
With Dim SubStrings() As String, SubString(N) can only contain a string. With Dim SubStrings() As Variant, SubString(N) can contain a string or an integer or a floating-point value. This is not good in most situations because a variant is slower to process than a string or a long and you will not be warned if you set it to the wrong sort of value for your code. However, I am going to store an array in SubString(N). I will be using what is called a ragged array because each row has a different number of columns.
Step 2, replace:
ReDim IndexCrnt(1 To ColMax)
ReDim IndexMax(1 To ColMax)
by:
ReDim IndexCrnt(1 To ColMax)
ReDim IndexMax(1 To ColMax)
ReDim SubStrings(1 To ColMax)
Step 3, replace:
' Initialise arrays
For ColCrnt = 1 To ColMax
SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
' SubStrings is a zero-based array with one entry
' per comma separated value.
IndexMax(ColCrnt) = UBound(SubStrings)
IndexCrnt(ColCrnt) = 0
Next
by:
' Initialise arrays
For ColCrnt = 1 To ColMax
SubStrings(ColCrnt) = Split(.Cells(1, ColCrnt).Value, ",")
IndexMax(ColCrnt) = UBound(SubStrings(ColCrnt))
IndexCrnt(ColCrnt) = 0
Next
With the first version, I overwrite the array SubStrings everytime I split a cell. With the second version, I save each column's substrings. With the values used by UJ9 in the original question, the new SubString looks like:
---- Columns -----
Row 0 1 2 3
1 abc def ghi jkl
2 1 2 3
3 a1 e3 h5 j8
Step 4: replace:
For ColCrnt = 1 To ColMax
SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
.Cells(RowCrnt, ColCrnt).Value = SubStrings(IndexCrnt(ColCrnt))
Next
by:
For ColCrnt = 1 To ColMax
.Cells(RowCrnt, ColCrnt).Value = SubStrings(ColCrnt)(IndexCrnt(ColCrnt))
Next
With the revised code I do not split a source cell for every generated value. I extract the substring I require from the array.
Note: if you have ever used two dimensional arrays, you will have written something like MyArray(Row,Column). Ragged arrays are different; you write MyArray(Row)(Column).
Here's a generalised solution that uses Recursion to handle any number of columns (greater than 1)
Sub Combinations()
Dim aSrc As Variant
' Get Data into an array
' This section is an example to get the source data into an array
' Replace this section if your data is sourced differently.
' The required format of aSrc is Array(1 To NumberOfColumnsOfData)
' where each element aSrc(n) is Array(1 To NumberOfRowsInColumnN, 1 To 1) of Variant
Dim rSrc As Range, colR As Range
Dim sh As Worksheet
Dim a As Variant
Dim i As Long
Set sh = ActiveSheet ' <-- Adjust to suit
Set rSrc = sh.[A:D] ' <-- Adjust to suit
ReDim aSrc(1 To rSrc.Columns.Count)
With sh
For i = 1 To rSrc.Columns.Count
Set colR = rSrc.Columns(i)
aSrc(i) = .Range(colR.Cells(1, 1), colR.Cells(.Rows.Count, 1).End(xlUp))
Next
End With
' Generate output
' This populates aDst(1 To lSize, 1 To NumberOfSourceColumns)
' where lSize is total number of combinations
Dim aDst As Variant
Dim lSize As Long
Dim n As Long
Dim aBase() As String
lSize = 1
For i = 1 To UBound(aSrc)
lSize = lSize * UBound(aSrc(i), 1)
Next
ReDim aDst(1 To lSize, 1 To UBound(aSrc))
ReDim aBase(0 To UBound(aSrc) - 1)
n = 1
aBase = Split(String(UBound(aSrc) - 1, ","), ",")
aBase(0) = aSrc(1)(1, 1)
Generate aSrc, aDst, aBase, 1, n
' Place output into sheet
' Starting at cell rDst
Dim rDst As Range
Set rDst = [E1] ' <-- Adjust to suit
Set rDst = rDst.Resize(UBound(aDst, 1), UBound(aDst, 2))
rDst = aDst
End Sub
Private Sub Generate(ByRef aSrc As Variant, ByRef aDst As Variant, ByRef aBase As Variant, ByVal pCol As Long, ByRef pDst As Long)
Dim i As Long, j As Long
If pCol = UBound(aSrc) Then
' If iterating the last source column, output to aDst
For i = 1 To UBound(aSrc(pCol), 1)
For j = 1 To UBound(aBase)
aDst(pDst, j) = aBase(j - 1)
Next
aDst(pDst, j) = aSrc(pCol)(i, 1)
pDst = pDst + 1
Next
Else
' If NOT iterating the last source column, aBase and call Generate again
For i = 1 To UBound(aSrc(pCol), 1)
aBase(pCol - 1) = aSrc(pCol)(i, 1)
Generate aSrc, aDst, aBase, pCol + 1, pDst
Next
End If
End Sub
I am trying to use conditional formatting to highlight a row of cells containing key value pairs in another column when certain watch cells are yellow. I have a three columns (A,B,C) containing numeric digits and then two columns (key 1, key2) that is also numeric. Next to the two columns are sensor attribute data that is yellowed under (AB,BC,AC). My code below is supposed to look at athe attribute cells and see under which columns (AB,BC,AC) are yellow. Then it takes the key pairs (key 1, key2) and finds a match in the three column matrix in terms of values and the relative order of the value in the three columns. I've been doing this manually and its so much of a pain I need to try to code it but I don't know if its possible. The problem I have is that the yellowed cells tells the relative order of the key pairs to find the match in the three columns and I do not know how to pull that off.
Sample file here: http://www.filefactory.com/file/a0egf75/n/Relative_Position_Macro_xls
Key 1 Key 2 AB BC AC AB BC AC
0 0 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
0 1 -1.5574 -1.5574 -1.5574 1.5574 1.5574 1.5574
0 2 2.1850 2.1850 2.1850 -2.1850 -2.1850 -2.1850
0 3 0.1425 0.1425 0.1425 -0.1425 -0.1425 -0.1425
0 4 -1.1578 -1.1578 -1.1578 1.1578 1.1578 1.1578
0 5 3.3805 3.3805 3.3805 -3.3805 -3.3805 -3.3805
0 6 0.2910 0.2910 0.2910 -0.2910 -0.2910 -0.2910
0 7 -0.8714 -0.8714 -0.8714 0.8714 0.8714 0.8714
0 8 6.7997 6.7997 6.7997 -6.7997 -6.7997 -6.7997
0 9 0.4523 0.4523 0.4523 -0.4523 -0.4523 -0.4523
1 0 1.5574 1.5574 1.5574 1.5574 1.5574 1.5574
1 1 0.0000 0.0000 0.0000 -2.1850 -2.1850 -2.1850
1 2 -1.5574 -1.5574 -1.5574 -0.1425 -0.1425 -0.1425
1 3 2.1850 2.1850 2.1850 1.1578 1.1578 1.1578
1 4 0.1425 0.1425 0.1425 -3.3805 -3.3805 -3.3805
1 5 -1.1578 -1.1578 -1.1578 -0.2910 -0.2910 -0.2910
1 6 3.3805 3.3805 3.3805 0.8714 0.8714 0.8714
1 7 0.2910 0.2910 0.2910 -6.7997 -6.7997 -6.7997
1 8 -0.8714 -0.8714 -0.8714 -0.4523 -0.4523 -0.4523
1 9 6.7997 6.7997 6.7997 0.6484 0.6484 0.6484
2 0 -2.1850 -2.1850 -2.1850 -2.1850 -2.1850 -2.1850
2 1 1.5574 1.5574 1.5574 -0.1425 -0.1425 -0.1425
2 2 0.0000 0.0000 0.0000 1.1578 1.1578 1.1578
2 3 -1.5574 -1.5574 -1.5574 -3.3805 -3.3805 -3.3805
2 4 2.1850 2.1850 2.1850 -0.2910 -0.2910 -0.2910
2 5 0.1425 0.1425 0.1425 0.8714 0.8714 0.8714
2 6 -1.1578 -1.1578 -1.1578 -6.7997 -6.7997 -6.7997
2 7 3.3805 3.3805 3.3805 -0.4523 -0.4523 -0.4523
2 8 0.2910 0.2910 0.2910 0.6484 0.6484 0.6484
A B C
0 8 9
0 7 8
0 6 7
0 5 6
0 4 5
0 7 9
0 3 4
0 5 7
0 2 3
0 4 6
0 5 8
2 1 5
0 4 7
0 5 9
0 4 8
0 4 9
0 3 7
0 2 5
0 3 9
0 1 3
0 2 6
0 2 7
0 1 4
0 2 9
0 1 5
0 1 6
0 1 7
0 1 8
0 1 9
If anyone can offer me some suggestions, I would really appreciate it.
Dim WatchRange As Range, Target As Range, cell As Range
Set WatchRange = Range("C4:H32")
Set Target = Range("J4:J32")
For Each cell In WatchRange.Cells
If ColorIndex: = 6 , A4 = J4, B4 = K4 Then: targetCell.Interior.ColorIndex = 3
Next watchCell
Else: cell.Interior.ColorIndex = xlNone
End If
Next cell
End Sub
AFAIR u can't work with worksheet_change because it doesn't fire if you only change the background color. The simplest solution is to add a button with the caption "highlight matrix" that walks through your sensordata and highlights the found rows in the matrix.
Private Sub highlightMatrix()
Dim SensorData As Range
Dim Matrix As Range
Dim yellowRows As Collection
Dim isYellow As Boolean
Dim iColumn As Integer
Set SensorData = Worksheets.Item(1).Cells(3, 1).CurrentRegion
Set Matrix = Worksheets.Item(1).Cells(3, 10).CurrentRegion
Set yellowRows = New Collection
For Each Row In SensorData.Rows ' walk the used rows of sensordata '
isYellow = False
iColumn = 3
While iColumn >= 3 And iColumn <= 8 And isYellow = False ' identify rows with yellow marked sensordata '
If Row.Cells(1, iColumn).Interior.ColorIndex = 6 Then
isYellow = True
yellowRows.Add (Row.Row)
End If
iColumn = iColumn + 1
Wend
Next Row
Matrix.Interior.ColorIndex = xlNone ' set matrix background to default '
For Each Item In yellowRows
For Each Row In Matrix.Rows
If Row.Cells(1, 1) = Worksheets.Item(1).Cells(Item, 1) And Row.Cells(1, 2) = Worksheets.Item(1).Cells(Item, 2) Then ' color found rows red '
Row.Cells(1, 1).Interior.ColorIndex = 3
Row.Cells(1, 2).Interior.ColorIndex = 3
Row.Cells(1, 3).Interior.ColorIndex = 3
End If
Next Row
Next Item
Set yellowRows = Nothing
End Sub
Its not the most efficient way to solve this problem but it should be fine with small worksheets.
Adding more Sensors:
The array/collection yellowRows stores the rownumbers of every key1/key2 combination that has at least one yellow sensor value. If you want to add other sensors, u could add the columns after the current 6 sensor rows (C - H) and set the matrix row to the new column position e. g. 13 instead of 10 and set iColumn <= 11 instead of 8 if u add 1 new sensor with 3 columns.
Adding more Matrices:
To add more matrices u simply need to add a matrix in the given layout anywhere and define a new range for the matrix e.g.
Set Matrix2 = Worksheets.Item(1).Cells(100, 1).CurrentRegion 'Matrix 2 starts in the 100. row on the 1. spreadsheet in the 1. column'
then just copy+paste the for loop of your original matrix(and change Matrix.Rows in Matrix2.Rows) in the yellowRows loops (now u have 2 Loops in your yellowRows loop)
Regarding your Sample file:
There was a "End Sub" at the start of
the Sub that needed to be deleted
The Matrix range was set wrong
the sensordata should start at column
Because you have an id column the line
If Row.Cells(1, 1) = Worksheets.Item(1).Cells(Item, 1) And Row.Cells(1, 2) = Worksheets.Item(1).Cells(Item, 2) Then ' color found rows red '
changes to
If Row.Cells(1, 1) = Worksheets.Item(1).Cells(Item, 2) And Row.Cells(1, 2) = Worksheets.Item(1).Cells(Item, 3) Then ' color found rows red '
the column loop should start at 5 and
end at 16
Here is the modified Sample File: http://www.mediafire.com/?vkbyv1n4m0t