What I am trying to do is get my macro to search the data in Column "E". If the cell value contains "string", then I would like to offset by one column to the left, verify if, in the new selected cell, cell value contains "". If the new selected cell value is "" then background color is 19, if it contains "*" then background color is -4142.
Here is the code I have so far:
Sub Set_Background_Color ()
lRow = Range("E" & Rows.Count).End(xlUp).Row
Set MR = Range("E2:E" & lRow)
For Each cell In MR
If cell.Value = "X" Then cell.Offset(, -1).Interior.ColorIndex = 19
Next
End Sub
I can't seem to figure out how to embed a new If statement after the Offset and before the .Interior.ColorIndex
I have tried this mess but you will see immediately that it does not work.
If cell.Value = "X" Then
ElseIf cell.Offset(, -1).Value = "" Then cell.Interior.ColorIndex = 19
Else: cell.Interior.ColorIndex = -4142
Any help is greatly apreciated!
So close!
Sub Set_Background_Color ()
Dim lRow As Long
Dim MR As Range
Dim cel As Range
lRow = Range("E" & Rows.Count).End(xlUp).Row
Set MR = Range("E2:E" & lRow)
For Each cel In MR
If cel.Value = "string" Then
If cel.Offset(, -1).Value = "" Then
cel.Offset(, -1).Interior.ColorIndex = 19
ElseIf cel.Offset(, -1).Value = "*" Then
cel.Offset(, -1).Interior.ColorIndex = -4142
End If
End If
Next
End Sub
If by contains "*" you mean "has any content" then:
If cell.Value = "X" Then
cell.Interior.ColorIndex = IIf(Len(cell.Offset(0, -1).Value) = 0, 19, xlNone)
End If
Related
I have a IF-Statement, and I need to loop it throug column F.
This loop checks for the word "empty" in column F and if found, it gets entered into columns G too. In column H the current date gets added, if it was not already in it. If F and G have "empty" in it, and H a date, the If-Statement gets ended.
If Range("F2").Value = "empty" And Range("G2").Value = "" Then
Range("G2").Value = "empty"
ElseIf (Range("F2").Value = "empty" And Range("G2").Value = "empty") And Range("H2").Value = "" Then
Range("H2") = Date
ElseIf (Range("F2").Value = "empty" And Range("G2").Value = "empty") And Range("H2").Value <> "" Then
End If
Can someone help me to add this into a loop, that goes trough the lines?
It manly needs to go trough line 2 to 1500.
Any help would be apprechiated.
Kind regards.
Nested Statements in a Loop
Sub NestedStatements()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim rg As Range: Set rg = ws.Range("F2:H1500")
Dim rrg As Range
For Each rrg In rg.Rows
If CStr(rrg.Cells(1).Value) = "empty" Then
Select Case CStr(rrg.Cells(2).Value)
Case ""
rrg.Cells(2).Value = "empty"
Case "empty"
If CStr(rrg.Cells(3).Value) = "" Then
rrg.Cells(3).Value = Date
End If
End Select
End If
Next rrg
End Sub
Try something like this
Dim i as long
For i = 2 to 1500
If Range("F" & i).Value = "empty" And Range("G" & i).Value = "" Then
Range("G" & i).Value = "empty"
ElseIf (Range("F" & i).Value = "empty" And Range("G" & i).Value = "empty") And Range("H" & i).Value = "" Then
Range("H" & i) = Date
ElseIf (Range("F" & i).Value = "empty" And Range("G" & i).Value = "empty") And Range("H" & i).Value <> "" Then
'do something
End If
Next i
I would create a single sub to do the job - to which you pass the range that should be checked:
Option Explicit
Private Const colF As Long = 6
Private Const colG As Long = 7
Private Const colH As Long = 8
'-->> this is an example of how to call the sub
Sub test_checkColumnsFtoH()
checkColumnsFtoH ThisWorkbook.Worksheets("Table1").Range("A1:I500")
End Sub
'-->> this is your new sub
Sub checkColumnsFtoH(rgToBeChecked As Range)
Dim i As Long
With rgToBeChecked
For i = 2 To .Rows.Count
If .Cells(i, colF).Value = "empty" And .Cells(i, colG).Value = "" Then
.Cells(i, colG).Value = "empty"
ElseIf (.Cells(i, colF).Value = "empty" And .Cells(i, colG).Value = "empty") _
And .Cells(i, colH).Value = "" Then
.Cells(i, colH) = Date
End If
Next
End With
End Sub
I am using the cells property to avoid string concatination ("H" & i)
you don't need the last elseif - as nothing happens there.
I have a large table of data with multiple columns that contain data for mostly triplicates of results. each row contains results from one data point for each subject. most of the subjects have three replicate results, but in some cases, there is only one or two. the sheet is sorted on the subject id column (which is my named range assigned to the variable rng used in the for loop).
this loop tests whether "targetcell" in the range "rng" (which is set to the named range in the sheet that contains the subject id), find the bottom row of any subjects duplicate or triplicate values, and then generates the mean in the newly inserted column:
Set rng = Range("clonesptid")
col = ActiveCell.Column
ActiveCell.Offset(0, 1).EntireColumn.Insert
anchor = col - rng.Column
'MsgBox "cell to test is " & rng(1)
'debugging message box to check where the ptid range is
'MsgBox "Range for ptID is " & rng.Column & " and the active cell address is " & ActiveCell.Address & " and the activecell col is " & anchor
For Each cell In rng
'uncomment the line below to check the cell addresses
' str = str & Cell.Address & " contains " & Cell.Value & "(above=" & Cell.Offset(-1, 0).Value & " below=" & Cell.Offset(1, 0).Value & vbNewLine
' MsgBox "What is our test value?" & vbNewLine & cell.Value
If IsEmpty(cell.Value) = True Then Exit For
targetcell = cell.Value
If cell.Row > 2 Then twoup = cell.Offset(-2, 0).Value
If cell.Row > 1 Then oneup = cell.Offset(-1, 0).Value
onedown = cell.Offset(1, 0).Value
If IsEmpty(targetcell) = False Then
If cell.Row = 1 Then
'adds title with means to first header row
Cells(1, col + 1).Value = Cells(1, col).Value & " mean"
ElseIf cell.Row = 2 And targetcell <> oneup And targetcell <> onedown Then
'test the first value, if unique mean = the value of the cell
cell.Offset(0, anchor + 1).Value = cell.Offset(0, anchor).Value
ElseIf targetcell <> oneup And targetcell <> onedown Then
'for all the rest of the cells in the range, this condition tests for singlets
cell.Offset(0, anchor + 1).Value = cell.Offset(0, anchor).Value
ElseIf targetcell = oneup And targetcell <> twoup And targetcell <> onedown Then
'test for two values
cell.Offset(0, anchor + 1).Value = (cell.Offset(0, anchor).Value + cell.Offset(-1, anchor).Value) / 2
ElseIf targetcell = oneup And targetcell = twoup And targetcell <> onedown Then
'test for three values
cell.Offset(0, anchor + 1).Value = (cell.Offset(0, anchor).Value + cell.Offset(-1, anchor).Value + cell.Offset(-2, anchor).Value) / 3
Else
'this is the first or second replicate of duplicates or triplicates, but not yet the bottom value
cell.Offset(0, anchor + 1).Value = ""
End If
End If
Next
If you have a specific operation like "find all same values up and down" then it's best to move that to a separate method.
Untested:
Sub tester()
Dim rng As Range, cell As Range, dups As Range
Dim lastDup As Range, col As Long, anchor As Long
col = ActiveCell.Column
Cells(1, col + 1).EntireColumn.Insert
Cells(1, col + 1).Value = "Mean"
Set rng = Range("clonesptid")
anchor = col - rng.Column
Set cell = rng.Cells(1)
Do While Len(cell.Value) > 0
Set dups = DupsRange(cell) 'get contiguous range with same value in column
Set lastDup = dups.Cells(dups.Cells.Count)
'calculate your average here
lastDup.Offset(0, anchor + 1) = Application.Average(dups.Offset(0, anchor))
Set cell = lastDup.Offset(1, 0) 'next set
Loop
End Sub
'Given a cell, check up and down to find
' the contiguous same-value range
Public Function DupsRange(c As Range) As Range
Dim cStart As Range, cEnd As Range
If Len(c.Value) = 0 Then Exit Function
Set cStart = c
Set cEnd = c
Do While cStart.Row > 1
If cStart.Offset(-1, 0).Value = c.Value Then _
Set cStart = cStart.Offset(-1, 0) Else Exit Do
Loop
Do While cEnd.Row < Rows.Count
If cEnd.Offset(1, 0).Value = c.Value Then _
Set cEnd = cEnd.Offset(1, 0) Else Exit Do
Loop
Set DupsRange = c.Parent.Range(cStart, cEnd)
End Function
I have a macro that has conditional statements in. It works perfectly if I take out the second statement of coloring the cell with the error message. Instead when I add the color to the cell I am returned with a FALSE statement in my column.
It works perfectly here:
Sub trantype()
Dim cell As Range
Dim lastRow As Long
Sheets("1099-Misc_Form_Template").Select
lastRow = Range("B" & Rows.Count).End(xlUp).row
For Each cell In Range("C2:" & "C" & lastRow)
If cell.Value <> "C" And cell.Value <> "" Then cell.Offset(0, -2).Value = cell.Offset(0, -2).Value & ", Tran type error"
Next
End Sub
But when I add the second condition I am returned with a FALSE statement:
Dim cell As Range
Dim lastRow As Long
Sheets("1099-Misc_Form_Template").Select
lastRow = Range("B" & Rows.Count).End(xlUp).row
For Each cell In Range("C2:" & "C" & lastRow)
If cell.Value <> "C" And cell.Value <> "" Then cell.Offset(0, -2).Value = cell.Offset(0, -2).Value & ", Tran type error" & cell.Interior.ColorIndex = 37
Next
End Sub
I would like both conditions to be met, so the error message is printed in the offset cell and the cell with the error in to have color.
Put each command into its own row. The & ampersand is a text concatenation operator. It cannot be used to chain commands.
For Each cell In Range("C2:" & "C" & lastRow)
If cell.Value <> "C" And cell.Value <> "" Then
cell.Offset(0, -2).Value = cell.Offset(0, -2).Value & ", Tran type error"
cell.Interior.ColorIndex = 37
End If
Next
This way you need to use the End If statement, so don't forget that.
I am writing a code that put an X in a cell depending on a offset cell value, for exemple if the offset cell has a value of 3, it will put an X in the cell and decrement the offset cell value, i want to save the location of that cell and start the next for each with it.
For Each Cell In plage
If (Cell.Offset(0, 1).Value <> 0) Then
If (Cell.Value <> "X") Then
Cell.Offset(0, 1).Value = Cell.Offset(0, 1).Value - 1
Cell.Value = "X"
Checkpoint = Cell.Address
Exit For
Else
Cell.Value = ""
GoTo NextStep
End If
Exit For
Else
Cell.Value = ""
End If
NextStep:
Next Cell
The problem i am having with the current code is it start the loop all over again while i want it to keep till the end of the lines, until all offset value are equal to 0.
Try the below (there are notes on the code). If you face difficulties let me know.
Option Explicit
Sub test()
'In this example we assume that the data you want to loop appear in Column A
Dim i As Long, Lastrow As Long
Dim Checkpoint As Variant
With ThisWorkbook.Worksheets("Sheet1") '<- Change sheet name if needed
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row '< -Fins the lastrow of the column you want to loop
For i = 2 To Lastrow ' < -Start looping from row 2 to Lastrow fo the column
If .Range("A" & i).Offset(0, 1).Value <> 0 Then '<- You are looping
If .Range("A" & i).Value <> "X" Then
.Range("A" & i).Offset(0, 1).Value = .Range("A" & i).Offset(0, 1).Value - 1
.Range("A" & i).Value = .Range("A" & i).Value & "X"
Checkpoint = .Range("A" & i).Address
Else
.Range("A" & i).Value = ""
End If
Else
.Range("A" & i).Value = ""
End If
Next i
End With
End Sub
Is plage a range?
If so, you could update it to start from the checkpoint and include all cells up to some lastCell for example.
Something like:
set plage=thisWorkbook.Worksheets("Your Worksheet").Range(checkpoint,lastCell)
That way the next For-Each should start from your checkpoint.
BTW if I understand correctly what you'e trying to do, I would suggest you replace cell.value="" with cell.clearContents
I have the following code below. Instead of using stagnant ranges (i.e., Range("AF9:AF50") & Range(AK9:BI50")) I'm looking to implement a dynamic range that runs the code starting at row 9 through the last row of data for those columns. I've been reading on how to set dynamic ranges but I can't get it to work. Any advice/assistance is greatly appreciated.
Private Sub Worksheet_Change(ByVal target As Range)
Dim cell As Range
Dim controlRng As Range, nRng As Range
Set cell = Range("AK9:BI50")
Set controlRng = Range("AF9:AF50")
Set nRng = Intersect(controlRng, target)
Application.EnableEvents = False
If Not nRng Is Nothing Then
Select Case target.Value
Case "No Promotion"
target.Offset(, 1).Value = Range("M" & target.Row).Value
target.Offset(, 4).Value = Range("P" & target.Row).Value
target.Offset(, 9).Value = ""
Case "Promotion"
target.Offset(, 1).Value = ""
target.Offset(, 4).Value = ""
target.Offset(, 9).Value = 0.07
Case "Demotion", "Partner", ""
target.Offset(, 1).Value = ""
target.Offset(, 4).Value = ""
target.Offset(, 9).Value = ""
End Select
End If
If Not Application.Intersect(cell, target) Is Nothing Then
Select Case target.Column
Case 37, 39, 43
target.Offset(, 1).Value = target.Value / Range("V" & target.Row).Value
Case 38, 40, 44
target.Offset(, -1).Value = WorksheetFunction.RoundUp((target.Value * Range("V" & target.Row).Value), -2)
Case 41, 60
target.Offset(, 1).Value = WorksheetFunction.RoundUp((target.Value * Range("V" & target.Row).Value), -2)
Case 42, 61
target.Offset(, -1).Value = target.Value / Range("V" & target.Row).Value
End Select
End If
Application.EnableEvents = True
End Sub
I'm assuming your problem is dealing with the letter aspect of ranges and trying to make that dynamic? If so the syntax you may be looking for is.
Set MyRange = MySheet.Range(MySheet.Cells(TopRow, LeftCol), MySheet.Cells(LastRow, RightCol))
So For example, these two ranges will be equivalent but the first can be generated dynamically.
TopRow = 1
LeftCol = 2
LastRow = 100
RightCol = 3
Set MyRange = MySheet.Range(MySheet.Cells(TopRow, LeftCol), MySheet.Cells(LastRow, RightCol))
Set MyOtherRange = mysheet.range("B1:C100")
There are several methods to find the last row of a column, some work better in other circumstances then others. Look here https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
I usually use this
LastRow = sht.Cells(sht.Rows.Count, ColumnNumber).End(xlUp).Row
If I understand the question correctly, the columns and starting rows are static and only a dynamic last row reference is needed.
In Worksheet_Change event:
Set cell = Range("AK9:" & LastRow("BI"))
Set controlRng = Range("AF9:" & LastRow("AF"))
Choose a row number larger than any number of rows your data will likely have (e.g.1000). Then, in the same module:
function LastRow(strColumn as string) as long
LastRow=range(strColumn & 1000).end(xlup).row
end function
VBA will re-calculate the LastRow every time the Worksheet_Change event is raised,
thus making your ranges dynamic.