I have two different spreadsheets A and B where both of them have a column consisting of server names. Some of the server names are in common and for this I want to make a conditional query in Excel where I first want to check if server names are equal and if so check if a column in A consisting of integer values have a limit of 90. If the server has a corresponding integer value greater than 90 I want to give a color fill in one of the B's column. So roughly a python like pseudo-code would look like:
for i in range(Spreadsheet A: Column 1):
for j in range(Spreadsheet B: Column 1):
if i==j:
if i.column 2 > 90:
color fill j.column2 red
else:
color fill j.column2 green
I just used a couple of hours to learn the VBA syntax, so the answer would look like:
Sub Patch()
Dim s1 As Worksheet
Set s1 = Sheets("Patch")
Dim s2 As Worksheet
Set s2 = Sheets("Report")
For i = 5 To 259
For j = 2 To 227
If s1.Cells(i, 1) = s2.Cells(j, 1) Then
If s1.Cells(i, 7) > 90 Then
s2.Cells(j, 1).Interior.Color = vbRed
Else
s2.Cells(j, 1).Interior.Color = vbGreen
End If
Else
End If
Next j
Next i
End Sub
Related
I am trying to color in the columns that correlate to the weekend (Friday through Sunday) on a calendar I've made on my sheet. In essence, the pattern would go something like 4 columns without fill, 3 with fill, 4 without, etc.
I would like to have a more elegant solution than what I have, bc mine (at the moment) is very sluggish and slow.
Note: rng = the range of my calendar
For Each col In rng.Columns
For Each cell In col.Cells
If k = 5 Or k = 6 Or k = 7 Then
cell.Interior.Color = RGB(210, 210, 210)
ElseIf k = 8 Then
k = 1
End If
Next cell
k = k + 1
Next col
A conditional formatting rule based on a formula involving the column index and the MOD function should do nicely.
Sub Bands_43()
With Worksheets("sheet2")
'reference columns B:Z
With .Range("B:Z")
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=AND(ROW(1:1)>3, MOD(COLUMN(A:A)-1, 7)>3)")
.Interior.Color = RGB(210, 210, 210)
End With
End With
End With
End Sub
Ive been trying to make something in Excel to find multiple combinations of sums.
I have list of numbers that needs to be added together to be either within ranges of 500-510 or 450-460.
Only two numbers from the list can be used to find the sum. the numbers can not be used more than once. and giving the combinations of multiple results would be great. and if a number is not used it is ok.
I've tried the solver add-in and some other tips I found from this site but could not find something that gives multiple answers.
Does anyone know if this will be possible?
I'd break this into 2 tasks. First would be to simply generate all of the index pairs to test in the input array. That's relatively simple with recursive procedure. This one uses a private Type to store the pairs, but it could adapted to use some other method of storing the pairs:
Private Type Tuple
ValueOne As Long
ValueTwo As Long
End Type
Private Sub FindCombinations(elements As Long, ByRef results() As Tuple, _
Optional ByVal iteration As Long = 0)
If iteration = 0 Then ReDim results(0)
Dim idx As Long
For idx = iteration To elements - 1
Dim combo As Tuple
With combo
.ValueOne = iteration
.ValueTwo = idx
End With
results(UBound(results)) = combo
If iteration <> elements And idx <> elements Then
ReDim Preserve results(UBound(results) + 1)
End If
Next
If iteration < elements Then FindCombinations elements, results, iteration + 1
End Sub
Then, you use a "entry-point" procedure to generate the index combinations, use those to index into your source array, and apply your selection criteria:
Private Sub FindMatchingSets(testSet() As Long)
Dim indices() As Tuple
FindCombinations UBound(testSet) + 1, indices
Dim idx As Long, results() As Tuple
For idx = LBound(indices) To UBound(indices)
Dim tupleSum As Long
tupleSum = testSet(indices(idx).ValueOne) + testSet(indices(idx).ValueTwo)
If indices(idx).ValueOne <> indices(idx).ValueTwo And _
((tupleSum >= 500 And tupleSum <= 510) Or _
(tupleSum >= 450 And tupleSum <= 460)) Then
Debug.Print testSet(indices(idx).ValueOne) & " + " & _
testSet(indices(idx).ValueTwo) & " = " & tupleSum
End If
Next
End Sub
It isn't clear what you intend to do with the results, so this simply outputs the calculated values to the Immediate Window. Example calling code:
Private Sub Example()
Dim test(4) As Long
test(0) = 100
test(1) = 200
test(2) = 250
test(3) = 260
test(4) = 400
FindMatchingSets test
End Sub
May modify it according to your need & try
Sub test()
Dim X, Y, TRw, GotNum, First, Second As Long
TRw = 1
With ThisWorkbook.ActiveSheet
For X = 1 To 100 ' assumed col A1 to A100 is the list
GotNum = .Cells(X, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
.Cells(X, 1).Font.Color = RGB(255, 0, 0)
First = GotNum
For Y = X + 1 To 100
GotNum = .Cells(Y, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
Second = GotNum
TRw = TRw + 1
.Cells(TRw, 3).Value = First ' write 1st Number in Col C
.Cells(TRw, 4).Value = Second ' write 2nd Number in Col D
.Cells(TRw, 5).Value = First + Second ' write Sum of 1st & 2nd in Col C
End If
Next Y
End If
Next X
End With
End Sub
I think your question needs to be a little clearer in terms of what your expected output is (do you want a list of combos, or just to see the results?), but here's my solution.
I've put a list of 20 numbers in column Y, and assigned them all a letter (a through to t) in column X
Then I've built a matrix of the combinations of a to t, and have entered the following formula (the below is for cell C3, but it can be copied and pasted into all parts of the matrix)
=IF(C$2=$B3,"x",VLOOKUP(C$2,$X:$Y,2,FALSE)+VLOOKUP($B3,$X:$Y,2,FALSE))
I've then used conditional formatting to set the colour of the cells if they meet your criteria for the sum - you can do this by highlighting all the sums (cell C3:V22) and going to
home / conditional formatting / new rule...
picking the rule type format only cells that contain
and then in the drop down menus picking Cell Value / Between / Your high range
and then selecting a format (fill background colour, usually)
Do this once for the "high" sum, and once for the "low" sum. You can make the colours the same or different, depending on what you want to see.
I've also for reference included a reference to what the number is in Row 1 and column A. The formula for row 1 is (example is for C1, but it can be copied across)
=VLOOKUP(C2,$X:$Y,2,FALSE)
And the formula for column A is (example for A3) =VLOOKUP(B3,$X:$Y,2,FALSE)
The advantage of this approach is that it's all in excel (no code required), but the disadvantage is that it's hard to get a list of results. You could use a different formula to just return the sum (e.g. return the text "205+298") when it meets one of the conditions, but then it's still a pain to get it out of the matrix format and into a single list. Much easier using VBA
In Excel, I have many products with different sizes listed in columns, such that the sizes "10x10 cm", "11x11 cm" and "15x15 cm" belongs to Product A, etc.
In some other cells, I am selecting a product (either Product A, Product B, or Product C) and a size.
I want, for each of the other products, to determine which size is closest to the selected product:
I don't know how to solve this. One solution might be to remove all non-numeric characters from the strings and add the two values on each side of the "x" and then select the size with the lowest absolute difference from the sum of the selected size.
But I guess it would be easier to do a mapping and use a VLOOKUP to choose the first found size in a given column.
However, the problem is that I do not only have 3 products with a few different sizes, but rather 15 different products with 10 different sizes, so I don't know how to do a mapping in a clever way.
1) Creating a lookup table with the values extracted for each product,
Source sheet:
Code:
Sub lookup()
Dim i As Long, j As Long, prod As Integer, str As String
prod = InputBox("Enter Number of Products")
Sheets.Add.Name = "LookupSheet"
j = 1
For i = 1 To prod
Columns(i).Copy Sheets("LookupSheet").Cells(1, j)
j = j + 2
Next i
For j = 1 To prod * 2 Step 2
For i = 2 To Sheets("LookupSheet").Cells(Rows.Count, j).End(xlUp).Row
str = Replace(Replace(Sheets("LookupSheet").Cells(i, j), " ", ""), "cm", "")
Sheets("LookupSheet").Cells(i, j + 1) = Left(str, InStr(str, "x") - 1) _
* Mid(str, InStr(str, "x") + 1, 999)
Next i
Next j
End Sub
This simple code creates a lookup sheet with the corresponding values. The code ignores any spaces present between the texts.
LookupSheet:
Since you have 15 different products, run this macro to extract the lookup data. This should be a one time activity unless you have additional products.
2) Assuming you enter the product and dimensions to F5 and F6, i would suggest you to data validation with dropdowns to select from the list,
3) Using a worksheet_change event, detect for changes in F5 and F6,
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String, result As Integer, i As Long
'F5 and F6 contains Product and Size repectively
If (Target.Address = "$F$5" Or Target.Address = "$F$6") _
And Range("F5") <> "" And Range("F6") <> "" Then
str = Replace(Replace(Range("F6"), " ", ""), "cm", "")
result = Left(str, InStr(str, "x") - 1) * Mid(str, InStr(str, "x") + 1, 999)
j = 8
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i) <> Range("F5") Then
Range("E" & j) = Cells(1, i)
j = j + 1
End If
Next i
End If
End Sub
This code automatically populated the rest of the product types in the column E,
4) The variable result would contain the product/area of the value that you provide in F6. The only task pending would be to loop through the lookup sheet to find the nearest match. The Algorithm is below,
Algorithm:
Compare cell F5 with the data in row 1 of lookup sheet (need to loop)
If they are equal, ignore and move to next value. If not, need to loop the immediate next column to find the next match, and populate the result in the corresponding cell in source sheet.
Algorithm for column wise looping is below,
Steps:
diff = cell.value - result
if diff < 0 then multiply diff by -1
loop:
nextdiff = nextcell.value - result (multiply by -1 if negative)
if nextdiff < diff then
diff = nextdiff
end if
end loop:
The cell value with the least difference would be your best match for that particular product type.
Bit lengthier explanation, hope this helps.
It's been 6 years since I've worked with Excel and i'm a little bit rusty. Here's my scenario:
I am exporting a list of issues to Excel. I need to be able differentiate the associated Link numbers in a cell (mulitple values) from each other. Example, i have two columns,
Key = the number for a ticket
Linked Issues = The Keys associated
I need a statement that would scan the Key column and find a match in the Linked Issues column. Then once the match is found the matching text will assume the font color of the Key.
Where this get complicated is each cell of the Linked Issues column could look something like this iss-3913, iss-3923, iss-1649. So essentially the scan would be for a match within the string. Any help is appreciated.
I am sorry, I don't have time to finish this right now, but wWould something like this help with maybe a loop for each cell in the first column?
Edit: Finished now, second edit to update to B5 and Z5, edit 3 fixed goof with column reference and updated to use variables to assign what column to look in.
Sub colortext()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
End Sub
or maybe
Something like this?
Excel VBA: change font color for specific char in a cell range
This is an old post but I thought I would provide my work around to the conditional formating issue I was having.
Sub colorkey()
start_row = 5
key_col = 2
flag_col = 4
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
Tval = Cells(i, flag_col).Value
Select Case Tval
Case "Requirement"
'cval = green
cVal = 10
Case "New Feature"
'cval = orange
cVal = 46
Case "Test"
'cval = lt blue
cVal = 28
Case "Epic"
'cval = maroon
cVal = 30
Case "Story"
'cval = dk blue
cVal = 49
Case "Theme"
'cval = grey
cVal = 48
Case "Bug"
'cval = red
cVal = 3
Case "NOT MAPPED"
'cval = Maroon
cVal = 1
End Select
Cells(i, key_col).Font.ColorIndex = cVal
i = i + 1 'increment the cell in the first column
Loop
End Sub
Sub colorlinked()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
MsgBox "Finished Scanning"
End Sub
I have an Excel Spreadsheet like this
id | data for id
| more data for id
id | data for id
id | data for id
| more data for id
| even more data for id
id | data for id
| more data for id
id | data for id
id | data for id
| more data for id
Now I want to group the data of one id by alternating the background color of the rows
var color = white
for each row
if the first cell is not empty and color is white
set color to green
if the first cell is not empty and color is green
set color to white
set background of row to color
Can anyone help me with a macro or some VBA code
Thanks
I use this formula to get the input for a conditional formatting:
=IF(B2=B1,E1,1-E1)) [content of cell E2]
Where column B contains the item that needs to be grouped and E is an auxiliary column. Every time that the upper cell (B1 on this case) is the same as the current one (B2), the upper row content from column E is returned. Otherwise, it will return 1 minus that content (that is, the outupt will be 0 or 1, depending on the value of the upper cell).
I think this does what you are looking for. Flips color when the cell in column A changes value. Runs until there is no value in column B.
Public Sub HighLightRows()
Dim i As Integer
i = 1
Dim c As Integer
c = 3 'red
Do While (Cells(i, 2) <> "")
If (Cells(i, 1) <> "") Then 'check for new ID
If c = 3 Then
c = 4 'green
Else
c = 3 'red
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub
Based on Jason Z's answer, which from my tests seems to be wrong (at least on Excel 2010), here's a bit of code that happens to work for me :
Public Sub HighLightRows()
Dim i As Integer
i = 2 'start at 2, cause there's nothing to compare the first row with
Dim c As Integer
c = 2 'Color 1. Check http://dmcritchie.mvps.org/excel/colors.htm for color indexes
Do While (Cells(i, 1) <> "")
If (Cells(i, 1) <> Cells(i - 1, 1)) Then 'check for different value in cell A (index=1)
If c = 2 Then
c = 34 'color 2
Else
c = 2 'color 1
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub
Do you have to use code?
if the table is static, then why not use the auto formatting capability?
It may also help if you "merge cells" of the same data. so maybe if you merge the cells of the "data, more data, even more data" into one cell, you can more easily deal with classic "each row is a row" case.
I'm barrowing this and tried to modify it for my use. I have order numbers in column a and some orders take multiple rows. Just want to alternate the white and gray per order number. What I have here alternates each row.
ChangeBackgroundColor()
' ChangeBackgroundColor Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
Dim a As Integer
a = 1
Dim c As Integer
c = 15 'gray
Do While (Cells(a, 2) <> "")
If (Cells(a, 1) <> "") Then 'check for new ID
If c = 15 Then
c = 2 'white
Else
c = 15 'gray
End If
End If
Rows(Trim(Str(a)) + ":" + Trim(Str(a))).Interior.ColorIndex = c
a = a + 1
Loop
End Sub
If you select the Conditional Formatting menu option under the Format menu item, you will be given a dialog that lets you construct some logic to apply to that cell.
Your logic might not be the same as your code above, it might look more like:
Cell Value is | equal to | | and | White .... Then choose the color.
You can select the add button and make the condition as large as you need.
I have reworked Bartdude's answer, for Light Grey / White based upon a configurable column, using RGB values. A boolean var is flipped when the value changes and this is used to index the colours array via the integer values of True and False. Works for me on 2010. Call the sub with the sheet number.
Public Sub HighLightRows(intSheet As Integer)
Dim intRow As Integer: intRow = 2 ' start at 2, cause there's nothing to compare the first row with
Dim intCol As Integer: intCol = 1 ' define the column with changing values
Dim Colr1 As Boolean: Colr1 = True ' Will flip True/False; adding 2 gives 1 or 2
Dim lngColors(2 + True To 2 + False) As Long ' Indexes : 1 and 2
' True = -1, array index 1. False = 0, array index 2.
lngColors(2 + False) = RGB(235, 235, 235) ' lngColors(2) = light grey
lngColors(2 + True) = RGB(255, 255, 255) ' lngColors(1) = white
Do While (Sheets(intSheet).Cells(intRow, 1) <> "")
'check for different value in intCol, flip the boolean if it's different
If (Sheets(intSheet).Cells(intRow, intCol) <> Sheets(intSheet).Cells(intRow - 1, intCol)) Then Colr1 = Not Colr1
Sheets(intSheet).Rows(intRow).Interior.Color = lngColors(2 + Colr1) ' one colour or the other
' Optional : retain borders (these no longer show through when interior colour is changed) by specifically setting them
With Sheets(intSheet).Rows(intRow).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(220, 220, 220)
End With
intRow = intRow + 1
Loop
End Sub
Optional bonus : for SQL data, colour any NULL values with the same yellow as used in SSMS
Public Sub HighLightNULLs(intSheet As Integer)
Dim intRow As Integer: intRow = 2 ' start at 2 to avoid the headings
Dim intCol As Integer
Dim lngColor As Long: lngColor = RGB(255, 255, 225) ' pale yellow
For intRow = intRow To Sheets(intSheet).UsedRange.Rows.Count
For intCol = 1 To Sheets(intSheet).UsedRange.Columns.Count
If Sheets(intSheet).Cells(intRow, intCol) = "NULL" Then Sheets(intSheet).Cells(intRow, intCol).Interior.Color = lngColor
Next intCol
Next intRow
End Sub
I use this rule in Excel to format alternating rows:
Highlight the rows you wish to apply an alternating style to.
Press "Conditional Formatting" -> New Rule
Select "Use a formula to determine which cells to format" (last entry)
Enter rule in format value: =MOD(ROW(),2)=0
Press "Format", make required formatting for alternating rows, eg. Fill -> Color.
Press OK, Press OK.
If you wish to format alternating columns instead, use =MOD(COLUMN(),2)=0
Voila!