I want to execute a series of code based on row number but want to keep the selection of row number flexible, so that i can execute code for row 15:15, 20:20 etc
here is the code i tried...
Dim i As Integer
i = 15
Rows("i:i").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("i-1:i-1").Select
Selection.Copy
Rows("i:i").Select
ActiveSheet.Paste
Rows("i:i").Select
Application.CutCopyMode = False
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("Ei-1").Select
Selection.ClearContents
Range("Ei-1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+(R[1]C-RC[-1])/2"
Range("Ei").Select
Something like this:
Dim i As Long
i = 15
Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(i - 1).Copy Rows(i)
With Rows(i).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("E" & i - 1).FormulaR1C1 = "=RC[-1]+(R[1]C-RC[-1])/2"
Related
Trying to get conditional formatting running through VBA code (since values change every day, also have a code to clean that deletes the Conditional formatting I did, non-VBA).
Want to highlight values on column P that are numeric > 0 and O4 > 0.
Sheets("RAW DATA FILE").Cells("A1").Select
Sheets("RAW DATA FILE").Columns("A:A").EntireColumn.AutoFit
Sheets("RAW DATA FILE").Range("P4").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(ISNUMBER($P4), $P4>0, $O4>0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
The first line triggers the error:
Run-time error '5'
Invalid procedure call or argument
Would appear there is an issue with your first line, should be Range instead of Cells:
Sub Conditional_formatting_2_conditions_met()
Sheets("RAW DATA FILE").Activate
Sheets("RAW DATA FILE").Range("A1").Select
Sheets("RAW DATA FILE").Columns("A:A").EntireColumn.AutoFit
Sheets("RAW DATA FILE").Range("$P:$P").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(ISNUMBER($P1), $P1>0, $O1>0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
You may use the loop throug all cells in range if You need to update more cells. You define the range at With .Range("P1:P10") line
Sub Conditional_formatting_2_conditions_met()
Dim lRow As Long
Dim cel As Range
With Sheets("RAW DATA FILE")
.Columns("A:A").EntireColumn.AutoFit
With .Range("P1:P10")
For Each cel In .Cells
With cel
lRow = lRow + 1
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=AND(ISNUMBER($P" & CStr(lRow) & "), $P" & CStr(lRow) & ">0, $O" & CStr(lRow) & ">0)")
.SetFirstPriority
.StopIfTrue = False
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
End With
End With
Next cel
End With
End With
End Sub
I am creating a card based database system and I want to use a button to basically be able to new cards, as seen here.
I have already created a button and assigned a macro to it, which when clicked adds a new row of these 'cards'. However, I need my macro to be dynamic whereby the new cards are always added 3 rows down from the previous row of cards. How can this be done?
Here is my code for the macro:
Range("B66:F75").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("B66:F75").Select
Range("F75").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B66").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Name:"
Range("B67").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Email:"
Range("B68").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Institution:"
Range("B70").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Research Focus:"
Range("B73").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Expertise:"
Range("B75").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Relevant Links:"
Range("B66:F75").Select
Selection.Copy
Range("H66").Select
ActiveSheet.Paste
Range("N66").Select
ActiveSheet.Paste
Range("W68").Select
I presume what needs to change is the range, to make it dynamic.
OP mentioned in comments that it can start from a blank sheet. So here is my solution.
I assume the entire spreadsheet if filled with the medium blue color so the code does not add that.
Option Explicit
Sub CreatingCards()
'Basic idea is that we will create a base row and then copy paste it "x" times.
Dim TotalRows As Long 'How many rows of cards to generate
Dim lRow As Long 'Used to keep track of the last row of text
Dim p As Long 'Used for looping
TotalRows = 4
With ActiveSheet.Range("B6:F15")
.Interior.ThemeColor = xlThemeColorAccent5
.Interior.TintAndShade = 0.799981688894314
.BorderAround Weight:=xlThin
End With
'Add Words
ActiveSheet.Range("B6").Value = "Name:"
ActiveSheet.Range("B7").Value = "Email:"
ActiveSheet.Range("B8").Value = "Institution:"
ActiveSheet.Range("B10").Value = "Research Focus:"
ActiveSheet.Range("B13").Value = "Expertise:"
ActiveSheet.Range("B15").Value = "Releveant Links:"
'Bold Headers
ActiveSheet.Range("B6").Font.Bold = True
ActiveSheet.Range("B7").Font.Bold = True
ActiveSheet.Range("B8").Font.Bold = True
ActiveSheet.Range("B10").Font.Bold = True
ActiveSheet.Range("B13").Font.Bold = True
ActiveSheet.Range("B15").Font.Bold = True
'Generate the other two cards in the row
ActiveSheet.Range("B6:F15").Copy
ActiveSheet.Range("H6").PasteSpecial xlPasteAll
ActiveSheet.Range("N6").PasteSpecial xlPasteAll
For p = 1 To TotalRows - 1 'Because we generated the first row of cards already
lRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Defines lRow as the last row with text in it.
Range("B6:R15").Copy
Range("B" & lRow + 3).PasteSpecial xlPasteAll 'Putting +3 allows for two blank rows between each card.
Next p
End Sub
I am trying to color every other column in my excel file, the excel file has 500 columns. I came up with a macro which colors 5 columns at a time. Is there a way I can color all the columns at once.Here is my code. I am looking for a code that colors all the columns and I do not have to do it manually.
Sub Macro2()
'
' Macro2 Macro
'
'
ActiveCell.Range("A1:A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Offset(0, 2).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range("A1:A19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Offset(0, 2).Range("A1:A19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Offset(0, 2).Range("A1:A19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Offset(0, 2).Range("A1:A19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
You can enumerate the Columns collection of the worksheet, and then for each Column, the 'column' property is the Column Index. Check that to see if it is even or odd, and set the colour.
Public Sub Colour()
Dim Column As Range
For Each Column In ActiveSheet.Columns
If Column.Column Mod 2 = 0 Then
Column.Interior.Color = vbRed
End If
Next Column
End Sub
To limit the columns, or change the how many are ordered, you can use a "for" loop instead of a For Each loop. Eg:
Public Sub Colour()
Dim colIndex As Long
For colIndex = 1 To ActiveSheet.Columns.Count Step 3 '//Step 3 means every third column.
ActiveSheet.Columns(colIndex).Interior.Color = vbRed
Next colIndex
End Sub
if you wanted to limit it to 500 columns:
Public Sub Colour()
Dim colIndex As Long
For colIndex = 1 To 500 Step 3 '//Step 3 means every third column.
ActiveSheet.Columns(colIndex).Interior.Color = vbRed
Next colIndex
End Sub
What I'm trying to do is change specific range cells to specific colours.
It works that When there is an increase and when it is more than -2.00% that it should be red. However, when it is decreasing from the previous time it should be green, and once it is below -2.00% it should go black again.
So basically The cell with data in starts at C2 and ends at H54.
It works in a row format where like C2 is the main then D2 is continue data, etc. C3 is a new main data and D3 is the continue of that data, etc.
My code that I have been testing but not getting right is as follows:
Range("C2").Select
If Range("C2").Value >= "-2.00%" Then
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ElseIf Range("C2").Value < "-2.00%" Then
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If
Range("D2").Select
If Range("D2").Value <= "-2.00%" & Range("C2").Value Then
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
ElseIf Range("D2").Value > "-2.00%" & Range("C2").Value Then
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ElseIf Range("D2").Value < "-2.00%" Then
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If
Range("E2").Select
If Range("E2").Value <= "-2.00%" & Range("D2").Value Then
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
ElseIf Range("E2").Value > "-2.00%" & Range("D2").Value Then
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ElseIf Range("E2").Value < "-2.00%" Then
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If
However, when it goes to below 2.00% it still is green, and same error stays even when it increase again...
I will appreciate any assistance in getting this done asap... If you know of a shorter method please put it down for me to test it out.
Thank you very much for taking the time to review this.
Here is a sample picture of the result and what it actually should be:
This seems to follow your business logic as I perceive it from the code and sample image(s).
Sub ject()
Dim r As Long, c As Long, vRTRNs As Variant, thrshld As Double
thrshld = 0.02
With Worksheets("Sheet2")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2)
.Cells.Font.ColorIndex = xlColorIndexAutomatic
vRTRNs = .Value2
For r = LBound(vRTRNs, 1) To UBound(vRTRNs, 1)
'deal with the first value
If vRTRNs(r, LBound(vRTRNs, 2)) >= thrshld Then
.Cells(r, 1).Font.Color = vbRed
End If
'the remainder of the columns in the row
For c = LBound(vRTRNs, 2) + 1 To UBound(vRTRNs, 2)
Select Case vRTRNs(r, c)
Case Is >= thrshld
.Cells(r, c).Font.Color = _
IIf(vRTRNs(r, c) >= vRTRNs(r, c - 1), vbRed, vbGreen)
Case Is < thrshld
.Cells(r, c).Font.ColorIndex = xlColorIndexAutomatic
End Select
Next c
Next r
End With
End With
End With
End Sub
Results:
I Set up a Macro that Finds the differences between the two rows and then highlights them. I want the macro to Cycle through the next two rows and do the same thing and go on until there are no more rows of data(This Number varies all the time). So the Next selection would be Rows 4:5 and it would Select the differences and highlight them and so on. How is this possible? Any help is greatly appreciated. Thank you,
FindVariance Macro
Rows("2:3").Select
Range("A3").Activate
Selection.ColumnDifferences(ActiveCell).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("F16").Select
End Sub
Try:
FindVariance Macro
For j=2 to Range("A1").End(xlDown).Row-1
i=j+1
Rows(j & ":" & i).ColumnDifferences(Range("A" & i)).Offset(1,0).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
j=j+1
Next j
End Sub
Here's my sample
Option Explicit
Sub FindVariance()
Dim last As Integer, i As Integer, r As Boolean
last = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For i = 2 To last
If i Mod 2 = 0 Then
Rows(i & ":" & i + 1).Select
r = Selection.ColumnDifferences(ActiveCell).Select
If r = True Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next i
Range("F16").Select
End Sub
it's always a good habit to:
use objects reference and avoid the use of selections
which can be deceiving and slows down the code
use full reference for ranges, up to the workbook.
to avoid point to an unwanted active sheet or workbook!
so here's my code
Sub FindVariance()
Dim j As Long
Dim nRows As Long
With ActiveSheet
nRows = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 2 To nRows Step 2
With .Rows(j).Resize(2).ColumnDifferences(.Cells(j + 1, 1)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next j
End With
End Sub
and there's still some job to do in order to catch and properly treat exceptions (uneven number of rows, empty rows...)