How to add to current cell selection in Excel VBA - vba

So I have a loop that checks every cell in a column and finds a specific date (currently the Monday of the previous week). My code right now does select them correctly but I want it to keep the previous selection so in the end all cells of that specification are selected
Public Function LastMonday(pdat As Date) As Date
LastMonday = DateAdd("ww", -1, pdat - (Weekday(pdat, vbMonday) - 1))
End Function
Sub Macro2()
Macro2 Macro
Dim rng As Range
Dim curCellValue As String
Dim mondayStr As String
mondayStr = Format(LastMonday(Date), "dd/mm/yyyy")
Set rng = Range(ActiveSheet.Range("E2"), ActiveSheet.Range("E2").End(xlDown))
For Each Cell In rng
curCellValue = Cell.Value
If curCellValue = mondayStr Then Cell.Select
Next Cell
End Sub
As a bonus, to change the Function to a different day of last week would I simply change the vbMonday to vbTuesday etc? I admit I don't know VBA very well and most of this is just frankensteined from around here.

The best way to do that is to store all the cells in a range using the Union Method.
Also I wouldn't recommend using .Select. You may want to see THIS
Amend your code to add this code.
Dim MySel As Range
For Each cell In Rng
If cell.Value = mondayStr Then
If MySel Is Nothing Then
Set MySel = cell
Else
Set MySel = Union(MySel, cell)
End If
End If
Next cell
If Not MySel Is Nothing Then
With MySel
'.Select
'~~> Do something
End With
End If
One more thing... Please note that xlDown should be avoided as much as possible. You may want to see THIS

Related

VBA: Look up date from range1 in range2 -> If match then color cell

to organize my projects, I created an excel sheet, which is basically a calendar, but the dates are not fixed and differ from project to project. Certain dates should be colored in different ways. Thus far I used conditional formatting to achieve this, but I find CF to not always work as I want it to. Besides, since I do a lot of copy & pasting, the CF rules add up enourmously over time, slowing down the worksheet. VBA might also be more flexible in the end.
I started with coloring the cell containing today's date, using the following code (I am a VBA/Coding beginner; the code is from another website, I just modified it to suit my demands).
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim Dates As Range
Set Dates = Range("B2:H2," & _
"B6:H6")
For Each cell In Dates
If Not IsDate(cell.Value) Then
End If
If IsEmpty(cell.Value) Then
End If
If cell.Value = Date Then
cell.Interior.ColorIndex = 3
'Include more conditions e.g. lookup date in list of holidays; if date = holiday then different color
ElseIf cell.Value - Date <> 0 Then
cell.Interior.ColorIndex = 0
End If
Next cell
End Sub
Now I'd also like the macro to compare the dates in the range.1 "Dates" with a list of other dates (range.2) (e.g. holidays). If a cell from "Dates" matches with a cell from range.2, the cell that matches is supposed to get another color.
This was no problem with CF but here I am really at a loss.
I tried to do it manually by adding
ElseIf cell.Value = cell(1, 1).Value Then
cell.Interior.ColorIndex = 2
However, this colors all cells, not only the cell that matches with the date in cell(1, 1).
Any help is greatly appreciated.
Kind regards
Dennis
This is an example; the code checks values in ColA to values in ColB, and if a match is found, colors the cell in ColA, Change the references as desired.
Dim xcel As Range
Dim ycel As Range
With Worksheets("Sheet1")
For Each xcel In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
For Each ycel In .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
If xcel.Value = ycel.Value Then
xcel.Interior.Color = RGB(255, 255, 0)
End If
Next ycel
Next xcel
End With
If you define range1 and range2 appropriately, the following will do the trick:
Sub colorCells()
Set range1 = Range("B1:B5")
Set range2 = Range("F1:F15")
For Each cel In range2
Set found = range1.Find(cel.Value, LookIn:=xlValues)
If found Is Nothing Then
cel.Interior.ColorIndex = 0
Else
cel.Interior.ColorIndex = 3
End If
Next cel
End Sub

Selecting a range of cells based on a loop variable

I've tried for days to find an answer to this but honestly, it might be a lack of knowledge in the subject that's causing me to not search for the right terms.
I have a spreadsheet with a series of dates between S7:GE7 and rows from 8:96 that have data that need to be locked the next day.
I know my way of selecting the columns is all wrong, and there's probably more wrong too but I can't think of a way to make it right.
Private Sub Workbook_Open()
Dim i As Range, cell As Range
Set i = Range("S7:GE7")
For Each cell In i
If (cell.Value < DateValue(Now())) Then
Range(i + "8:96").Locked = True
End If
Next cell
End Sub
What I'm hoping to achieve with this is a loop that looks through the dates in S7:GE7, and if the date is older than today it locks cells 8:96 in that column.
Any help that can be provided would be much appreciated. Thanks
Try this:
Private Sub Workbook_Open()
Dim i As Range, cell As Range
Set i = Range("S7:GE7")
For Each cell In i
If (cell.Value < DateValue(Now())) Then
cell.Offset(1, 0).Resize(79, 1).Locked = True
End If
Next cell
End Sub

Use User-defined range as input for cell parsing

I'm writing a macro in Excel 2010 in order to remove line breaks in multiple cells of a column. This cells need to be selected by the user. Following this previous post I was able to create an InputBox to let the user select the range but now, I am unable to process the data within the selection.
My previous code without the selection range parsed an entire column with a regexp to find a pattern in the string within the cells and change its contents.
I did this with a For i To Rows.Count block of code like this:
For i = 1 To Rows.Count
If Not IsEmpty(Cells(i, 5).Value) Then
varString = Sheets(ActiveSheet.Name).Cells(i, 5).Text
Sheets(ActiveSheet.Name).Cells(i,5).Value=objRegExp.Replace(varString, "$1 ")
End If
Next i
Now I want to replace the static column so I can process only the user range.
In order to achieve that I tried this:
Set selection = Application.InputBox(Prompt:= _
"Please select a range to apply the remove break lines procedure.", _
Title:="Remove Line Breaks", Type:=8)
If selection Is Nothing Then
Exit Sub
End If
Set RowsNumber = selection.CurrentRegion -> This line gives me an error: "Object required"
Set RowsNumber = RowsNumber.Rows.Count
For i = 1 To RowsNumber
If Not IsEmpty(Cells(i, 5).Value) Then
varString = Sheets(ActiveSheet.Name).Cells(i, 5).Text
Sheets(ActiveSheet.Name).Cells(i, 5).Value = objRegExp.Replace(varString, "$1 ") 'Replace pattern found with regular expression in the same line
End If
Next i
How can I access the cells in the range returned by the InputBox?
I also tried changing RowsNumber with selection.Rows.Count but that way, although it doesn't gives an error, the cells used have blank string within them when I run the debugger. I think this is because I try to access row = 5 when the range could be less, i.e 3 if user just selects 3 cells.
I tried a For Each Next loop but then again, I know not how to access the cells withing the selection range.
You can iterate through the cells of a range by using For Each loop.
Below is your code modified. I have changed the name of variable Selection to rng, because Selection is Excel library built-in function and this name should be avoided.
Sub x()
Dim rng As Excel.Range
Dim cell As Excel.Range
Set rng = Application.InputBox(Prompt:= _
"Please select a range to apply the remove break lines procedure.", _
Title:="Remove Line Breaks", Type:=8)
If rng Is Nothing Then
Exit Sub
End If
For Each cell In rng.Cells
If Not IsEmpty(cell.Value) Then
varString = cell.Text
cell.Value = objRegExp.Replace(varString, "$1 ") 'Replace pattern found with regular expression in the same line
End If
Next cell
End Sub

How to fill color in a cell in VBA?

I would like to color cells that have "#N/A" value in the currentsheet. In order to do this i use following macro:
Sub ColorCells()
Dim Data As Range
Dim cell As Range
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
Set Data = currentsheet.Range("A2:AW1048576")
For Each cell In Data
If cell.Value = "#N/A" Then
cell.Interior.ColorIndex = 3
End If
Next
End Sub
But the line If cell.Value = "#N/A" Then gives an error: Type mismatch. Maybe someone can help to understand where is the error? Thanks
Non VBA Solution:
Use Conditional Formatting rule with formula: =ISNA(A1) (to highlight cells with all errors - not only #N/A, use =ISERROR(A1))
VBA Solution:
Your code loops through 50 mln cells. To reduce number of cells, I use .SpecialCells(xlCellTypeFormulas, 16) and .SpecialCells(xlCellTypeConstants, 16)to return only cells with errors (note, I'm using If cell.Text = "#N/A" Then)
Sub ColorCells()
Dim Data As Range, Data2 As Range, cell As Range
Dim currentsheet As Worksheet
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
With currentsheet.Range("A2:AW" & Rows.Count)
.Interior.Color = xlNone
On Error Resume Next
'select only cells with errors
Set Data = .SpecialCells(xlCellTypeFormulas, 16)
Set Data2 = .SpecialCells(xlCellTypeConstants, 16)
On Error GoTo 0
End With
If Not Data2 Is Nothing Then
If Not Data Is Nothing Then
Set Data = Union(Data, Data2)
Else
Set Data = Data2
End If
End If
If Not Data Is Nothing Then
For Each cell In Data
If cell.Text = "#N/A" Then
cell.Interior.ColorIndex = 4
End If
Next
End If
End Sub
Note, to highlight cells witn any error (not only "#N/A"), replace following code
If Not Data Is Nothing Then
For Each cell In Data
If cell.Text = "#N/A" Then
cell.Interior.ColorIndex = 3
End If
Next
End If
with
If Not Data Is Nothing Then Data.Interior.ColorIndex = 3
UPD: (how to add CF rule through VBA)
Sub test()
With ActiveWorkbook.Sheets("Comparison").Range("A2:AW" & Rows.Count).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:="=ISNA(A1)"
.Item(1).Interior.ColorIndex = 3
End With
End Sub
Use conditional formatting instead of VBA to highlight errors.
Using a VBA loop like the one you posted will take a long time to process
the statement If cell.Value = "#N/A" Then will never work. If you insist on using VBA to highlight errors, try this instead.
Sub ColorCells()
Dim Data As Range
Dim cell As Range
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
Set Data = currentsheet.Range("A2:AW1048576")
For Each cell In Data
If IsError(cell.Value) Then
cell.Interior.ColorIndex = 3
End If
Next
End Sub
Be prepared for a long wait, since the procedure loops through 51 million cells
There are more efficient ways to achieve what you want to do. Update your question if you have a change of mind.
Select all cells by left-top corner
Choose [Home] >> [Conditional Formatting] >> [New Rule]
Choose [Format only cells that contain]
In [Format only cells with:], choose "Errors"
Choose proper formats in [Format..] button
You need to use cell.Text = "#N/A" instead of cell.Value = "#N/A". The error in the cell is actually just text stored in the cell.

If a cell inside a range is the same as a string, do calculation in the cell under it

I am trying to write up a macro in VBA.
I want my macro to check if a value inside a range of cells is the same as the value of another cell. Then i want it to identify the cell and do something in the cell under that one.
So, i want to check if the range B2:M6 has a cell with the same value as A1. Is this is true for cell D6, i want to perform a calculation on the cell under it, in this case B7.
For the moment i´ve only achieved to check the values inside the range but now i dont know what to do.
Sub CellCheck()
Dim DateString As String
DateString = Range("A1")
result = IsNumeric(WorksheetFunction.Match(DateString, Range("B6:M6"), 0))
If result = True Then MsgBox "It is True"
End Sub
You could use .FIND() or a simple loop:
Sub FindIt()
Dim V As Variant, rBig As Range, r As Range
V = Range("A1").Value
Set rBig = Range("B2:M6")
For Each r In rBig
If r.Value = V Then
r.Offset(1, 0) = "XXX"
End If
Next r
End Sub