I'm looking for a way to highlight cells in sheet1 if they match the value in sheet2. Here is the code I have, there aren't any errors coming up but it does nothing. Basically I thought a Do while loop to go through all the records until it hit a blank and then it would read the cell value selected by my offset and compare it to the next sheets cell value while staying on the same row, and if it matched it would highlight on sheet 1 but if it didn't it would move on. Let me know how much I'm off here as I don't have much VBA knowledge. Thanks.
Public Sub RoundedRectangle1_Click()
Dim resource As Range
Dim register As Range
Dim cancel As Range
Set resource = Worksheets("Resource List1").Cells(2, 4)
Set register = Worksheets("Registered List").Cells(2, 1)
Set cancel = Worksheets("Cancelled List").Cells(2, 1)
Call findRegister(resource, register)
End Sub
Public Sub findRegister(ByRef resource As Range, ByRef register As Range)
Dim i As Integer
i = 0
Do While resource.Offset(i, 3) <> ""
If resource.Offset(i, 3).Value = register.Range("A2").Value Then
resource.Offset(i, 3).Cells.Interior.ColorIndex = 37
End If
i = i + 1
Loop
End Sub
Your code is essentially correct, but I think you're having trouble with referencing the right cells. A good debugging technique would be to add .Cells.Interior.ColorIndex = 4 or something similar in your code to see visually whether you're referencing the proper cells. You can also put "F5", "F8", and breakpoints to good use in figuring out what's wrong. See http://www.excel-easy.com/vba/examples/debugging.html if you've never used these.
For example:
Do While resource.Offset(i, 3) <> "" '<--Insert a breakpoint on this line,
'then press "F8" to make sure the
'code inside your Do While loop is
'being executed
resource.Offset(i, 3).Cells.Interior.ColorIndex = 4
register.Range("A2").Cells.Interior.ColorIndex = 6
If resource.Offset(i, 3).Value = register.Range("A2").Value Then
resource.Offset(i, 3).Cells.Interior.ColorIndex = 40
End If
i = i + 1
Loop
Maybe something as simple as this . . . .
Sub Compare2Shts()
For Each Cell In Worksheets("CompareSheet#1").UsedRange
If Cell.Value <> Worksheets("CompareSheet#2").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next
For Each Cell In Worksheets("CompareSheet#2").UsedRange
If Cell.Value <> Worksheets("CompareSheet#1").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next
End Sub
Related
I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values.
The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.
The following is the code I've started working with:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub
Private Sub KeyCellsChanged()
Dim Cell As Object
For Each Cell In Range("E3")
Cell.Interior.ColorIndex = 3
Next Cell
End Sub
However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.
Any help is much appreciated!
Here is my favorite way to detect changes in an Excel VBA app:
Create an exact copy of the range you're watching in hidden rows below the range the user sees.
Add another section below that (also hidden) with formulas subtracting the user range with the hidden range with an if statement that sets the value to 1 if the difference is anything but 0.
Use conditional formatting in the user range that changes the background color of the row if the corresponding change-detection row (or cell) is > 0.
What I like about this approach:
If a user makes a change and then reverts back to the original value, the row is "smart enough" to know that nothing has changed.
Code that runs any time a user changes something is a pain and can lead to problems. If you set up your change detection the way I'm describing, your code only fires when the sheet is initialized. The worksheet_change event is expensive, and also "may effectively turn off Excel’s Undo feature. Excel’s Undo stack is destroyed whenever an event procedure makes a change to the worksheet." (per John Walkenbach: Excel 2010 Power Programming)
You can detect if the user is navigating away from the page and warn them that their changes will be lost.
Depending on your answer to my question in the comments, this code may change. Paste this in the relevant Worksheet code area. For this to work, navigate to any other sheet and then navigate back to the original sheet.
Option Explicit
Dim PrevVal As Variant
Private Sub Worksheet_Activate()
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ExitGraceFully
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
ExitGraceFully:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
Dim aCell As Range, i As Long, j As Long
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
Range("E" & Target.Row).Interior.ColorIndex = 3
ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
i = 1
For Each aCell In Target
If aCell.Value <> PrevVal(i, 1) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
i = i + 1
Next
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
Dim pRow As Long
i = 1: j = 1
pRow = Target.Cells(1, 1).Row
For Each aCell In Target
If aCell.Row <> pRow Then
i = i + 1: pRow = aCell.Row
j = 1
End If
If aCell.Value <> PrevVal(i, j) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
j = j + 1
Next
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
Resume LetsContinue
End Sub
SNAPSHOTS
It works as expected When you type a value in the cell. It also works when you copy 1 Cell and paste it in multiple cells. It doesn't work when you copy a block of cells and do a paste (I am still working on this)
NOTE: This is not extensively tested.
I would like to be able to construct a macro that is easily able to transfer cell content from one spreadsheet to another. Let me elaborate in more detail: I currently have two spreadsheets open. See picture. The worksheet on the left works via a button macro that I made (not included in picture) and generates three different adjacent values. Thus every time I would click the button, a new output would be generated.
What I would like to be able to do is to transfer that information from the worksheet on the left to the worksheet on the right into columns G, H, and I respectively (by potentially clicking the button on the right worksheet) and then having it go to the next blank row to prepare for next round of generated values.
I'm having a bit of trouble constructing this (beginner). Could you offer some assistance?
Here is what I have so far:
Sub Button1_Click()
If Not Intersect(ActiveCell, Range("G:G")) Is Nothing Then
If ActiveCell.Offset(1, 0) <> vbNullString Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Workbooks("Model.xlsx").Worksheets("Optimization").Range("C100").Value
ActiveCell.Offset(0, 1).Value = Workbooks("Model.xlsx").Worksheets("Optimization").Range("D100").Value
ActiveCell.Offset(0, 2).Value = Workbooks("Model.xlsx").Worksheets("Optimization").Range("E100").Value
End If
End If
End Sub
Thanks!
This should work
Sub Button1_Click()
Const RowToTakeInformation = 100
Const ColumnToTakeInformation = 3
Const ColToWriteIn = 7
Dim WBDesired As Workbook: Set WBDesired = Workbooks("Model.xlsx")
Dim WSDesired As Worksheet: Set WSDesired = Worksheets("Optimization")
'If everything is in the same WB, I don't see a valid reason why to set it
Dim RowToInsert As Long
Dim CounterColumnsToWrite As Long
If WBDesired.Worksheets(WSDesired.Name).Cells(RowToTakeInformation, ColumnToTakeInformation).Value <> "" Then ' 1. If WBDesired.Worksheets(WSDesired.Name).Cells(RowToTakeInformation, ColumnToTakeInformation).Value <> ""
'here I'm assuming it's a table or something like it that automatically recalculates when something is inserted in between
RowToInsert = Cells(Rows.Count, ColToWriteIn).End(xlUp).Row - 1
Rows(RowToInsert).Insert Shift:=xlDown
For CounterColumnsToWrite = 0 To 2
Cells(RowToInsert, ColToWriteIn + CounterColumnsToWrite).Value = WBDesired.Worksheets(WSDesired.Name).Cells(RowToTakeInformation, ColumnToTakeInformation + CounterColumnsToWrite)
Next CounterColumnsToWrite
End If ' 1. If WBDesired.Worksheets(WSDesired.Name).Cells(RowToTakeInformation, ColumnToTakeInformation).Value <> ""
End Sub
Here is the code below:
Public n as Long ' <--above sub procedure
With Sheets("Sheet1").Range("A6").Offset(n, 0)
If n = 0 Then
.Value = 1
Else
.Value = .Parent.Range(.Address).Offset(-1, 0) + 1
End If
n = n + 1
End With
(See pic below) If I delete 4 then click command button again it just reset back to 1. I want to make it static so even I deleted the last value of row it still continue increment from the last value.
Store number
1
2
3
4
Try this:
Sub Test()
Dim trow As Long
With Sheets("Sheet1") '~~> change to suit
trow = .Range("A:A").Find(vbNullString, [A5]).Row
With .Range("A" & trow)
If trow = 6 Then .Value = 1 _
Else .Value = .Offset(-1, 0).Value + 1
End With
End With
End Sub
Above code finds the first blank cells. If it is A6 it assigns a value of 1.
Otherwise it assigns previous cell value plus 1. Is this what you're trying?
Edit1: Explanation
trow = .Range("A:A").Find(vbNullString, [A5]).Row
This finds the first empty row in Column A starting A5.
[A5] is used to return Range("A5") object. So it can also be written as:
trow = .Range("A:A").Find(vbNullString, .Range("A5")).Row
We used a VBA vbNullString constant as What argument in Range Object Find Method.
Find Method returns a Range Object so above can be written also like this:
Sub Test()
Dim r As Range
With Sheets("Sheet1") '~~> change to suit
Set r = .Range("A:A").Find(vbNullString, [A5])
With r
If .Row = 6 Then .Value = 1 _
Else .Value = .Offset(-1, 0).Value + 1
End With
End With
End Sub
What your asking for, a button with memory doesn't sound neatly solvable using just VBA.
You could potentially have a list on a hidden sheet that gets a value added to it each time the commandButton is pressed and it writes the max of the list values back to the target cell?
Alternatively you could investigate using a scrollbar from the form control section of the developer tab with a link to your target cell. I often use this technique for interactive sheets.
Named Range Method
Public sub btnPress
dim val as long
val = Range("PreviousCellValue")
set Range("PreviousCellValue") = val+1
Sheets("Sheet1").Range("A6").Offset(n, 0).value = Range("PreviousCellValue")
End sub btnPress
Maybe due to my poor English some of you may misunderstood what I wanted to do. Anyways, here is the code that I wanted. After many trial and errors I made it but I doubt its the best way but it works =). If anyone know how to make the code better please tell me =).
I previous post is also below this new code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim row As Integer
For row = 1 To 1000
If Cells(row, "A").Value = "Yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
If Cells(row, "A").Value = "yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
Next row
End Sub
Previous post
I have written a VBA code in excel where I want to change a cell color everytime I write "yes". In this case I write "yes" in column E and column A should change color. I have used a for loop but it does not run as I want. I have a feeling I am thinking a bit wrong...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellNr As Long
For cellNr = 1 To 5
If Range("E" & cellNr).Value = "yes" Then
Range("A" & cellNr).Interior.ColorIndex = 5
Else
ActiveCell(0, -2).Interior.ColorIndex = 4
End If
Next cellNr
End Sub
Use conditional formatting with a formula. Starting in row 1 the formula required is
=$E1="yes"
If I understand what you are trying to do with the following line:
ActiveCell(0, -2).Interior.ColorIndex = 4
Replace it with:
ActiveCell.Offset(0, -2).Interior.ColorIndex = 4
As far as I know, the line I told you to remove will always throw an error. It doesn't make any sense syntactically. You should use the Offset function to get positions relative to the Active Cell. But also, this offset function will throw an error if your active cell is in column A or B because there are less than 2 columns to the left of the active cell.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rOfInterest As Range
Set rOfInterest = Range("E1:E5")
If Intersect(Target, rOfInterest) Is Nothing Then Exit Sub
v = Target.Value
If v = "yes" Then
Target.Offset(0, -4).Interior.ColorIndex = 5
Else
Target.Offset(0, -4).Interior.ColorIndex = 4
End If
End Sub
and make sure the macro is in the worksheet code area.
I recently had a question regarding how to copy a cell value into all cells below it and stop based on when column A got to a blank cell. post
The excel sheet I'm working in has many divider rows that are color filled across the entire row to separate categories as you scroll down the sheet. I would like to be able to skip these separating rows in column A when the macro checks for a blank cell in column A. Or I would like to just assign StopRow to the first cell which has no formatting/no color/no value.
Here is what I have, thanks to Ripster earlier today, but I've failed incorporating a proper if then statement with what he came up with.
Sub Example()
Dim MasterValue As String
Dim StopRow As Long
Dim i As Long
'Get the master value
MasterValue = Range("C5").Value
'Get the first blank cell in column A
StopRow = Range("A1").End(xlDown).Row
'Start at row 6 and continue to the "Stop Row"
For i = 6 To StopRow
'Set every cell from row 6 in column 3 to the "Master Value"
Cells(i, 3).Value = MasterValue
Next
End Sub
Please help.
Thanks
This took me a while but I found solution to your problem ;)
If macro goes to cell with different color - checking and do nothin, next "i" is taken. This should do what u want. It's possible to add more color ;)
Link to colors - http://dmcritchie.mvps.org/excel/colors.htm
Sub Example()
For i = 6 To 1200
If Cells(i, 3).Interior.ColorIndex = 1 Then 'here is color black
Else
If IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop
Exit For
Else
Cells(i, 3).Value = Range("C5").Value
End If
End If
Next i
End Sub
Your conditions for StopRow aren't clear. Do you want to set StopRow when the cell has a conditional formatting rule or simply when it has a different format than the default ? A cell may have a rule but it may not be applied. Anyway, the function presented here is something you might find of use.
Copy the ActiveCondition function somewhere in a module and then change your for loop like so:
For i = 6 To StopRow
If ActiveCondition(Cells(i,3))=0 Then StopRow=i : Exit For
Cells(i, 3).Value = MasterValue
Next
If you want to check for change in font color that didn't come from conditional formatting then you'd need an extra line:
For i = 6 To StopRow
If ActiveCondition(Cells(i,3))=0 Then StopRow=i : Exit For
If Cells(1,3).Font.ColorIndex=0 Then StopRow=i : Exit For
Cells(i, 3).Value = MasterValue
Next
There are more elegant ways to do this but this solution is the easiest to implement in your code.
Hope this helps.