Compare the nearest cells - excel

I need to compare one cell with next and if next is greater more than 3 than first, than to make it's color.
example: 1 2 6 3 2 8
1 compare with 2 = do not do nothing
2 compare with 6 = make it's color
6 compare with 3 = make it's color to
3 compare with 2 = do not do nothing
2 compare with 8 = make it's color.
Here is code that make cells less then 4 color, but I can't understand how to diff one cell with next :(
Sub Color()
Dim i As Integer
For i = 1 To 7
With ActiveSheet.Cells(i)
If .Value < 4 Then
.Interior.Color = QBColor(10)
End If
End With
Next i
End Sub
Upd:
Oh! Look like I have found solution!
Sub Color()
Dim i As Integer
For i = 1 To 7
With ActiveSheet.Cells(i)
If ActiveSheet.Cells(i) < ActiveSheet.Cells(i + 1) Then
ActiveSheet.Cells(i + 1).Interior.Color = QBColor(10)
End If
End With
Next i
End Sub

You could use conditional formatting for this rather than VBA, Debra covers this topic thoroughly here, http://www.contextures.com/xlcondFormat01.html
In your case:
Select A1:E1
Conditional Formatting ... New Rule (different menu options depending on your Excel version)
Use a formula to determine what cells to format
use =B1-A1>3 to add a relative formula
Pick a fill colour
screenshot from xl2010 below

Related

How to color columns in 4/3/4/3 pattern?

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

Adding up values in columns with conditions

Being beginner and first time on this site, I truly appreciate your help.
WK 1 WK 2 WK 3 WK 4 WK 5 TOTAL HOURS TOTAL OF FIRST 3 WEEKS <> 0
John 10 0 5 6 5 26 21
Smith 4 1 10 3 4 22 15
Peter 0 4 4 4 2 14 12
Susan 5 5 0 5 8 23 15
From my table I want to add only the first three columns that contain no zero. If there's zero on first three, check on next column and add it up to complete three columns again with no zero value. Some function like in Col H TOTAL OF FIRST 3 WEEKS <>0 (where I had to do it manually).
If I can learn set of VB code or any example with formula or macros, thank you so so much. I'm using Excel 2007.
This is the complicated formula Ali M refers to. It's an array formula entered with ctrl-shift-enter:
=IF(COUNTIF(A2:F2,"<>0")=0,0,SUM(A2:INDEX(A2:F2,SMALL(IF(A2:F2<>0,COLUMN(A2:F2),""),MIN(3,COUNTIF(A2:F2,"<>0"))))))
Note that it works if there are less than three non-zero values.
you can use formula but it would be complicated. instead you can use this subroutine that act exactly as you want!
Public Sub y()
Dim i, sum, c As Integer
Dim Rng, Row, cell As Range
Set Rng = Range("B2:F5")
i = 0
For Each Row In Rng.Rows
For Each cell In Row.Cells
If (cell.Value <> 0 And i < 3) Then
sum = sum + cell.Value
i = i + 1
End If
Next cell
Cells(Row.Row, 7).Value = sum
sum = 0
i = 0
Next Row
End Sub
It always put the sum in column H. you can change it by changing this line:
Cells(Row.Row, 7).Value = sum

Insert row every X rows in excel

I have a long list of codes such as 008.45, etc that will need multiple lines of text to explain them. I have the list of codes and I would like to know how I can automatically insert a row every, say, fifth row. Example Below
1
2
3
4
5
6
7
8
9
10...
100
Every five rows I would like to insert a given number of my choosing of rows. How can I do this? Thanks
Test with a range from row 1 to row 100.
Sub InsertRows()
For i = Sheet1.UsedRange.Rows.Count To 1 Step -5
For j = 0 To 4
Sheet1.Rows(i).Insert
Next
Next
End Sub
You would need to use a loop as below:
for i=1 to 100 step 1
if i mod 5 = 0 then
// Insert the rows
end if
next i
This worked great for me:
Sub add_rows_n()
t = 6
Do Until Cells(t, "A") = ""
Rows(t).Insert
t = t + 6
Loop
End Sub
To insert a row at row myRowNumber, your VBA code would look like this:
Rows(myRowNumber).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
You can incorporate that into Andy's answer.
Or you could use the modulus function like so:
=IF(MOD(ROW()-1,7),"",A1)
in B1, where A1 is the first number of your dataset.
NB: Change 7 to n to get every n'th row.
For example if I want 5 of my records between my rows of data I would use Mod 6, however, you need to allow for these new rows as they will affect the used range count! To do this you will want to add the number of rows that will be inserted to the length of the loop (eg. Absolute value of(numberOfRows/YourModValue)).
Code to do this:
Sub InsertRows()
For i = 1 To Sheet1.UsedRange.Rows.Count + Abs(Sheet1.UsedRange.Rows.Count / 6) Step 1
If i Mod 6 = 0 Then
Sheet1.Rows(i).Insert
Cells(i, 1).Value = "Whatever data you want in your new separator cell"
End If
Next i
End Sub
Here's the code I wound up with. Note that the FOR loop actually runs backwards from the end of UsedRange. The Mod 5 inserts a row every 5 rows.
For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If (i - 1) Mod 5 = 0 Then
ActiveSheet.Rows(i).Insert Shift:=xlDown
End If
Next

Creating a border around cells with the same value

I have a table like the one below. How can I get Excel to put borders around groups with the same number in the 4th column so that there is a border around the groups. I was thinking conditional formatting could do it but I can't think how. So I think the only option is a macro. Could anybody help?
1 64436 549419 1
2 64437 549420 1
3 64438 549421 1
4 64439 549422 1
5 64440 549423 1
6 64441 549424 1
7 64442 549425 1
8 64443 549426 1
9 64444 549427 1
10 64445 549428 1
11 64446 549429 1
12 64447 549430 1
13 64448 549431 2
14 64449 549432 2
15 64450 549433 2
16 64451 549434 2
17 64452 549435 2
18 64453 549436 2
19 64454 549437 2
20 64455 549438 2
21 64456 549439 2
22 64457 549440 4
23 64458 549441 4
24 64459 549442 5
25 64460 549443 5
26 64461 549444 5
27 64462 549445 5
28 64463 549446 5
29 64464 549447 5
30 64465 549448 6
31 64466 549449 6
32 64467 549450 6
33 64468 549451 6
34 64469 549452 6
35 64470 549453 6
36 64471 549454 6
37 64472 549455 9
38 64473 549456 9
39 64474 549457 9
You need to use relative referencing.
Select the column range you want to do the conditional formatting on.
Enter the following three formulas in their own conditions:
=AND($C2=$C3,$C3=$C4)
This one is for the middle items. (Borders on both sides)
=AND($C2<>$C3,$C3=$C4)
This one is for the first in the group. (Border on left, top, right)
=AND($C2=$C3,$C3<>$C4)
This one is for the last in the group. (Border on left, bottom, right)
Format them as you want.
Replace all '$C' with '${Your Column}'. Note that this will not place any borders around single items since you can have no more the three conditional formatting conditions in a selection.
I cannot see a simple non-macro solution to exactly what you need but the solution from PowerUser seems okay.
Here is a macro based solution that will put a border around rows that have the same digit in the final column. I will assume your data are in columns A:D.
To use this macro just click any cell within your list and then fire the macro.
As a quick guide:
AddBorders is the main macro that simply loops through all the cells in the final column and works out when a border is appropriate
AddBorder is a short routine that adds the border.
As a bonus, AddBorder selects a random color from Excel's 56 color palette so that each of your borders are different colors to make easier viewing
Sub AddBorders()
Dim startRow As Integer
Dim iRow As Integer
startRow = 1
For iRow = 2 To ActiveCell.CurrentRegion.Rows.Count
If WorksheetFunction.IsNumber(Cells(iRow + 1, 4)) Then
If Cells(iRow, 4) <> Cells(iRow - 1, 4) Then
AddBorder startRow, iRow - 1
startRow = iRow
End If
Else
AddBorder startRow, iRow
End If
Next iRow
End Sub
Sub AddBorder(startRow As Integer, endRow As Integer)
Dim borderRange As Range
Dim randomColor As Integer
randomColor = Int((56 * Rnd) + 1)
Set borderRange = Range("A" & startRow & ":D" & endRow)
borderRange.BorderAround ColorIndex:=randomColor, Weight:=xlThick
End Sub
I came out with this solution, it works strange on my Excel 2010 :/
I cannot test it on 2003, so please let me know if thats fine.
Sub PaintBorder()
Dim iRow As Integer
iRow = 1
Dim strTemp As String
strTemp = Range("D" & iRow).Value
Dim strPrev As String
Dim sectionStart As Integer
sectionStart = 1
Do
strPrev = strTemp
strTemp = Range("D" & iRow).Value
If strPrev <> strTemp Then
ActiveSheet.Range(Cells(sectionStart, 1), Cells(iRow - 1, 4)).BorderAround xlSolid, xlMedium, xlColorIndexAutomatic
sectionStart = iRow
End If
iRow = iRow + 1
Loop Until strTemp = vbNullString
End Sub
Are you just trying to make it more readable to human eyes? If so, I recommend alternating background colors. For example, every time, the number in that 4th column changes, the background color would change from white to blue and vice-versa. I do this all the time:
Make an additional column E. Since your reference column is D, enter:
=MOD(IF(D5<>D4,E4+1,E4),2)
(i.e. if this row's column D is different from the last row's D, then change from either 0 to 1 or 1 to 0)
Hide the column so that the end-user doesn't see it.
Make 2 conditional formulas. The first will change the row color to white if your hidden value is 0. The second will change it to blue if your hidden value is 1.
No macros. No VBA coding. Just 1 hidden column and a few conditional formulas. And the colors should still alternate properly even though your column D is skipping numbers :)
(I use this daily on XL 2003. I hope it works on 2007)

Alternating coloring groups of rows in Excel

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!

Resources