How can I get headings "underproject" to be darker marked automatic? I can do it myself, but want it to happen automatic for all headings.
Before & After
Range("A6:L6,A7:D7").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
You can do this with conditional formatting. Select the whole table column A to column G and add a new conditional formmating rule and choose the bottom option to enter a formula. enter =left($A1,4)="Unde" click the format button and choose the format you want.
Select the Columns A to C and create another conditional formatting rule and select formula. Enter =left($A1,4)="Navn" and set the format that you want.
this won't merge the cells but in my opinion it is better no keep the cells unmerged as it allows you to sort and filter the data if required.
It is possible using a Macro but you would have to loop through all the cells in column A looking for "Navn" and "Underproject" and use if statements to set the formats.
Code to delete rows based on heading
I can't tell from your comment what it is exactly that you want to delete but to can change the critera to suit your requirements.
IMPORTANT: make sure that you make a backup copy of your data before running this macro as changes made by the macro cannot be undone.
Sub DeleteEx()
Dim intRow As Integer
Dim strContinue As String
Dim bolDelete As Boolean 'true or false
intRow = 2
strContinue = Cells(intRow, 1) ' the value in A2
bolDelete = False
Do While strContinue <> "" ' this loop will continue down each row as long as there is a value in column A
If Left(strContinue, 5) = "Under" Or Left(strContinue, 5) = "Navn:" Then 'change this to match your criteria
'delete the current row
Rows(intRow & ":" & intRow).Delete Shift:=xlUp
intRow = intRow - 1 ' because we deleted a row
End If
intRow = intRow + 1
strContinue = Cells(intRow, 1)
Loop
End Sub
Related
Struggling with this one. Have a table with many columns but looking to apply the conditional formatting to a subset. Table looks like below. Number/name of columns are fixed but number of rows varies based on some user inputs. Below image shows the table
Table Image
With this table I am looking to apply the color scale conditional formatting on a row by row basis. The added wrinkle is the formatting needs to be dependent on the value in the column titled "Sign". Logic goes if Sign value in row is "+" then applies color scale with green for highest value, red for lowest and white for 50th percentile (used macro recorder to capture stock color scales in excel to produce code below). If Sign value in row is "-" then I reverse it with Red for highest value, green for lowest.
My code is as per below. Problem I'm facing is it is duplicating the formatting for each row MANY times and slowing down everything. Any ideas why its duplicating the formatting for each row?
Any help is GREATLY appreciated!
Dim Rng As Range
Dim cel As Range
Dim i As Integer
Application.ScreenUpdating = False
For Each Rng In Worksheets("Sheet1").Range("Table1[[Sign]:[TREND5]]").Rows
For Each cel In Rng.Cells
For i = 1 To Len(cel)
If cel.Value = "+" Then
Rng.FormatConditions.AddColorScale ColorScaleType:=3
Rng.FormatConditions(Rng.FormatConditions.Count).SetFirstPriority
Rng.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Rng.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Rng.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Rng.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Rng.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 16776444
.TintAndShade = 0
End With
Rng.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Rng.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
ElseIf cel.Value = "-" Then
Rng.FormatConditions.AddColorScale ColorScaleType:=3
Rng.FormatConditions(Rng.FormatConditions.Count).SetFirstPriority
Rng.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Rng.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
Rng.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Rng.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Rng.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 16776444
.TintAndShade = 0
End With
Rng.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Rng.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
End If
Next i
Next
Next
Application.ScreenUpdating = True
End Sub
I know this question may get asked a lot, but I haven't been able to find or understand the answer for exactly what I am looking for.
I am learning VBA in excel for the first time today and I am trying to auto-format a table of values and want this to work on different range sizes.
I am stuck on how to select the row underneath the last row in my selection and format it.
My code so far is:
Selection.CurrentRegion.Select
Selection.Rows("1:1").Interior.Color = 12155648
With Selection.Rows("1:1").Font
.ThemeColor = xlThemeColorDark1
.Bold = True
End With
Selection.CurrentRegion.Select
Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Select
Selection.Interior.Color = 12632256
Selection.Font.Bold = True
Selection.Range("A1").Value = "Total"
What I want to happen:
Original
Desired Formatting
What about making it into an actual table
Sub Demo()
With ActiveSheet.ListObjects.Add(xlSrcRange, ActiveCell.CurrentRegion, , xlYes)
.Name = "MyTable" ' optional
.ShowTotals = True
End With
End Sub
Before
After
No, it isn't a common question because most programmers learn on their second day (that's tomorrow in your schedule) not to "Select" anything and use the Range object instead. Then your code would look more like this:-
Private Sub Snippet()
Dim Rng As Range
With Selection.CurrentRegion
.Rows(1).Interior.Color = 12155648
With .Rows(1).Font
.ThemeColor = xlThemeColorDark1
.Bold = True
End With
Set Rng = ActiveSheet.Cells(.Row + .Rows.Count, .Column).Resize(1, .Columns.Count)
End With
With Rng
.Interior.Color = 12632256
.Font.Bold = True
.Cells(1).Value = "Total"
End With
End Sub
You may use the following method, assuming your table start from B4:
Sub ty()
Dim lastrow As Long
lastrow = Sheet1.Range("B4").End(xlDown).Row + 1
With Sheet1.Range("B4").Resize(1, 5)
.Interior.Color = 12155648
.Font.ThemeColor = xlThemeColorDark1
.Font.Bold = True
End With
Sheet1.Cells(lastrow, 2).Value = "Total"
With Sheet1.Cells(lastrow, 2).Resize(1, 5)
.Interior.Color = 12632256
.Font.Bold = True
End With
End Sub
Conditional Formatting Condition:If selected cell("cel7") is not blank then put Black fill on it.
How can i modify my current code in such away that conditional formatting condition is used in cel7.
I tried to use xlnoblankscondition but i could not find any VBA examples of it on web.
P.S:As i have written all cel7 cell as C1,every condition will be true ie NOT BLANK.
x = ws.Range("A4").Value
y = ws.Range("A5").Value
ocol = 4
Set cel = Range("E6")
Set cel7 = cel.Offset(2, 0)
For m = 1 To x
For o = 1 To y
cel7.Value = "C1"
cel7.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Set cel7 = cel7.Offset(4, 0)
Next
Set cel = cel.Offset(0, ocol)
Set cel7 = cel7.Offset(0, ocol)
Next
I'm sorry as I'm still not clear on what you mean.
Anyway, I'm guessing that you want to coding the Conditional Formatting, just like when you do it manually.
I find the code below after I macro recording my manual step in Conditional Formatting.
I think the code in your condition maybe like this :
Sub test()
Cells.FormatConditions.Delete
cel7.Select
cf = cel7.Address(0, 0)
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NOT(ISBLANK(" & cf & "))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.WindowState = xlMaximized
End Sub
I try the code above by having cel7 variable refer to cell D10.
After I run the code, if I type something in cell D10, D10 fill black with white font.
If I clear the content of D10, D10 back to normal (no fill).
Also I try by having cel7 variable to a range D2 to D10.
If I type on any cell within D2:D10, the cell fill black with white font.
If I clear it, the cell back to normal.
But once again, maybe that's not what you want to achieve.
If I'm not mistaken read your code, it seems that your cel7 formatting is a non-contagious row. So please try your o loop like this one :
Cells.FormatConditions.Delete 'put this line before m loop
For m = 1 To x
For o = 1 To y
Cel7.Select
cf = Cel7.Address(0, 0)
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NOT(ISBLANK(" & cf & "))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.WindowState = xlMaximized
Set Cel7 = Cel7.Offset(4, 0)
Next o
In the code below I took out your Selection of Cel7. You can address the range directly. I also added variable declarations. Omitting them causes more work than it saves. For the rest of it, the cell color is applied if the cell is found not to be Empty.
Sub Macro1()
Dim Ws As Worksheet
Dim Cel As Range, Cel7 As Range
Dim Tmp As Variant
Dim oCol As Long
Dim x As Long, y As Long
Dim m As Long, o As Long
Set Ws = ActiveSheet
x = Ws.Range("A4").Value
y = Ws.Range("A5").Value
oCol = 4
Set Cel = Ws.Range("E6")
Set Cel7 = Cel.Offset(2, 0)
For m = 1 To x
For o = 1 To y
With Cel7
Tmp = "C1" ' avoid read/write to sheet multiple times
.Value = Tmp
If IsEmpty(Tmp) Then
.Interior.Pattern = xlNone
Else
.Interior.Color = vbBlack
End If
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Set Cel7 = Cel7.Offset(4, 0)
Next o
Set Cel = Cel.Offset(0, oCol)
Set Cel7 = Cel7.Offset(0, oCol)
Next m
End Sub
I am trying to dynamically generate random values from 0 to 5 in 3 separate columns and a changing number of rows. The values must sum up to 5 on each row and to a specific value on column. The sum of the column is different in each column.
My sheet calculates the needed value on each of the 3 columns and the needed number of rows.
I have average skills with formulas an none with VBA, but interested to learn.
Explanation
The following code uses the number found in column B and calculates a random numbers, looping until it finds the last row in column B. The axis are fully formatted by the macro. The only thing this macro requires to run are values in column B.
The code has been heavily commented for further explanation.
Steps on how to include the macro in your workbook
Step 1: Open VBA (hotkey while in Excel: alt-F11)
Step 2:
a) If you have more than one sheet open, navigate to the correct worksheet. The names are listed on the left hand menu.
b) Because this code defines the sheet (Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")), you can copy/paste this code into in either the worksheet it is going to run in (in this example, it would be Sheet1), Thisworkbook, or you can add it into a module (Module1 in the picture). Remember to give the Sub a better name than "test" :)
Steps on how to create a button
Step 1: If your Excel does not have the option for you to create a button from your title bar, follow these steps else skip to Step 2.
a) Click the dropdown in your title bar
b) Click "More Commands..."
c) Click "Choose commands from:" and select "Developer Tab"
d) Click "Design Mode" then click Add>>. Design Mode will let you click a button without activating the macro. This option will now display on your title bar.
e) Click "Insert Controls" then click Add>>. Insert Controls will be the option to create a button. This option will now display on your title bar.
Step 2:
a) Click on the Insert Controls icon on your title bar.
b) Click "Button (Form Control)" (upper left option).
c) Your mouse cursor will now be a cross hair when you hover over cells within your workbook. Click and drag to create a button.
d) You will be automatically prompted to select a macro to assign to the button. Choose the macro you just copy/pasted.
Step 3: Click your button / enjoy your macro.
Code (tested)
Sub test()
' dim your variables. this tells vba what type of variable it is working with
Dim lRow As Long
' defining wb is easier than typing out ThisWorkbook everytime
Dim wb As Workbook: Set wb = ThisWorkbook
' defining ws is easier than typing out Worksheets("Sheet1") everytime
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
' find the last row in column b (2) in the above defined ws
lRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
' loop through rows 3 to last row
For i = 3 To lRow
' generate a random number between 0 and the row contents of column B (5)
ws.Cells(i, 3).Value = Int(Rnd() * (ws.Cells(i, 2).Value + 1))
' generate a random number between 0 and the difference between column B and colum C
ws.Cells(i, 4).Value = Int(Rnd() * (ws.Cells(i, 2).Value - ws.Cells(i, 3).Value))
' subtract the difference between column B and the sum of column C and column D
ws.Cells(i, 5).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value)
Next i
' sum column C (column 3) and place the value in C2
ws.Cells(2, 3).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 3), Cells(lRow, 3)))
' sum column D (column 4) and place the value in D2
ws.Cells(2, 4).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 4), Cells(lRow, 4)))
' sum column E (column 5) and place the value in E2
ws.Cells(2, 5).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 5), Cells(lRow, 5)))
' format from A3 to the last row in column A - cell alignment / merge cells / value
With ws.Range(Cells(3, 1), Cells(lRow, 1))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.Value = "row sum"
End With
' format from C1 to E1 - cell alignment / merge cells / value
With ws.Range(Cells(1, 3), Cells(1, 5))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.Value = "column sum"
End With
' format from B3 to the last row in column B - color formatting
With ws.Range(Cells(3, 2), Cells(lRow, 2)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' format from C2 to E2 - color formatting
With ws.Range(Cells(2, 3), Cells(2, 5)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
I'm not sure if the heading is accurately describing what my query is, so I'll try my best to describe it here.
I have a sheet that keeps track of expenses and income and I have a macro that I use to insert check boxes into selected cells, link the checkbox to those cells and finally, apply a condition for a conditional format once the checkbox is checked and likewise if it is unchecked again.
Here is code that does that:
Sub:
Sub Insert_Checkbox_Link_Cell()
Dim rngCel, myCells As Range
Dim ChkBx As CheckBox
Dim cBx As Long
Set myCells = Selection
myCells.NumberFormat = ";;;"
Application.ScreenUpdating = False
For Each rngCel In myCells
With rngCel.MergeArea.Cells
If .Resize(1, 1).Address = rngCel.Address Then
Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
With ChkBx
.Value = xlOff
.LinkedCell = rngCel.MergeArea.Cells.Address
.Text = ""
.Width = 18
.Top = rngCel.Top + rngCel.Height / 2 - ChkBx.Height / 2
.Left = rngCel.Left + rngCel.Width / 2 - ChkBx.Width / 2
.Select
'Function Call
Selection.OnAction = "Change_Cell_Colour"
End With
End If
End With
Next rngCel
If (Range(ChkBx.LinkedCell) = "True") Then
myCells.Interior.ColorIndex = 43
Else
myCells.Interior.ColorIndex = 48
End If
Application.ScreenUpdating = True
End Sub
Function:
Function Change_Cell_Colour()
Dim xChk As CheckBox
Dim clickedCheckbox As String
clickedCheckbox = Application.Caller
Set xChk = ActiveSheet.CheckBoxes(clickedCheckbox)
If xChk.Value = 1 Then
ActiveSheet.Range(xChk.LinkedCell).Interior.ColorIndex = 43
Else
ActiveSheet.Range(xChk.LinkedCell).Interior.ColorIndex = 48
End If
End Function
So how this works is, I select the range of cells I want to have the checkboxes in, then I run the macro and it inserts the checkboxes as stated above.
Now I am wanting to add a little more and I am not sure if it is possible.
In the image below, I have listed income and at the bottom is the total. So, as the money comes in, the checkbox is checked.
What I would like to do is this:
While the checkbox is UNCHECKED, I don't want the value in the cell to be added to the total count at the bottom.
When it is CHECKED, then the value in the cell should be added to the total count at the bottom.
Image 1: No Check Boxes
Image 2: Check Boxes Added
Image 3: One Check Box Checked
Image 4: 2 Checkboxes Checked
You could achieve this using Conditional Formatting and SUMIF formula to achieve this
I've used the following conditional formatting rules (You will need to change this for your ranges)
The conditional formatting is applied to both the cell fill and also the font text colour (to make the True/False be 'invisible')
In cell C6 (a merged range) I have the formula
=SUMIF($D$3:$D$5,TRUE,$C$3:$C$5)
Where cells in the D range contain the values of the linked cells for the checkboxes (i.e. True, False)and C range is the values you want to sum.
This is a much simpler approach then any VBA solution and personally, I'd remove the formatting of the cells from your vba above and just use the conditional formatting.
If you're looking for a VBA way to initiate this (except for the SUMIF formula) I've updated your below code to add the conditional formatting
Sub Insert_Checkbox_Link_Cell()
Dim rngCel, myCells As Range
Dim ChkBx As CheckBox
Dim cBx As Long
Set myCells = Selection
myCells.NumberFormat = ";;;"
Application.ScreenUpdating = False
For Each rngCel In myCells
With rngCel.MergeArea.Cells
If .Resize(1, 1).Address = rngCel.Address Then
Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
With ChkBx
.Value = xlOff
.LinkedCell = rngCel.MergeArea.Cells.Address
.Text = ""
.Width = 18
.Top = rngCel.Top + rngCel.Height / 2 - ChkBx.Height / 2
.Left = rngCel.Left + rngCel.Width / 2 - ChkBx.Width / 2
End With
End If
End With
Next rngCel
With myCells
' Set default value
.Value2 = False
' Add conditional formatting for False value
With .FormatConditions
.Add Type:=xlExpression, Formula1:="=" & myCells.Cells(1).Address(False, True) & "=False"
End With
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 9868950
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Font
.Color = -6908266
.TintAndShade = 0
End With
End With
' Add conditional formatting for True value
With .FormatConditions
.Add Type:=xlExpression, Formula1:="=" & myCells.Cells(1).Address(False, True) & "=True"
End With
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 52377
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Font
.Color = -16724839
.TintAndShade = 0
End With
End With
End With
Application.ScreenUpdating = True
End Sub
You can give a value (eg: 1 for checked and 0 for unchecked) to the cell where the checkbox is added in your color change function. keep the cell's font color the same as the cell's fill color so that the value will be invisible to naked eyes. then in the total sum section, you can use sumif function.