I use this script to clear the contents of an adjacent cell if a certain text is found. However, I don't know how to change the range from the current region to strictly columns A to T. I tried ActiveSheet.Range("A:T").Select but that did not work.
Any help would be appreciated. Here is the code:
Sub Clear_Text()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Range("A1").CurrentRegion
For Each rng2 In rng1
If rng2 Like "Error" Or _
rng2 Like "Mistake" Then rng2.Offset(, 1).ClearContents
Next
End Sub
looping through all cells of a given range could be time consuming
you could use Find() function to jump to relevant cells only:
Option Explicit
Sub Clear_Text()
With Range("T1", Cells(Rows.Count, "A").End(xlUp))
CheckAndClear .Cells, "Error"
CheckAndClear .Cells, "Mistake"
End With
End Sub
Sub CheckAndClear(rng As Range, strng As String)
Dim f As Range
Dim firstAddress As String
With rng
Set f = .Find(what:=strng, LookIn:=xlValues, lookat:=xlPart) '<--|with 'lookat:=xlPart' parameter specification makes you catch cell that contains the searched string
If Not f Is Nothing Then
firstAddress = f.Address
Do
f.Offset(, 1).ClearContents
Set f = .FindNext(f)
Loop While f.Address <> firstAddress
End If
End With
End Sub
Try it like this to limit search range to columns A:T:
Sub Clear_Text()
Dim cl As Range
For Each cl In ActiveSheet.Range("A1:T" & Range("A1").CurrentRegion.Rows.Count)
If cl Like "Error" Or cl Like "Mistake" Then
cl.Offset(0, 1).ClearContents
End If
Next
End Sub
Related
The worksheet I'm working with has two cells filled in, one with Total and the other with value. They are next to each other. My goal is to catch the Total and print it's value. As I do not wish to know their specific cell address so I created a loop and did the job. I did it using .SpecialCells(xlCellTypeLastCell). Now, I would like to do the same using .UsedRange.
My question is: how can I do the same (creating the loop) using .UsedRange.
This is I have tried with (working one):
Sub FindTotalValue()
Dim rng As Range, cel As Range
'Set rng = ActiveSheet.UsedRange
'For Each cel In rng.Row
For Each cel In Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell))
If InStr(cel.Value, "Total") > 0 Then MsgBox cel.Offset(0, 1).Value
Next cel
End Sub
As I know nothing about creating a loop using .usedrange method, I just commented them out within the script.
Give this a try:
Sub FindTotalValue()
Dim rng As Range, cel As Range
For Each cel In ActiveSheet.UsedRange.Cells.SpecialCells(2)
If InStr(cel.Value, "Total") > 0 Then MsgBox cel.Offset(0, 1).Value
Next cel
End Sub
It assumes that the cell containing "Total" is a constant, not a formula:
You should also investigate using Find() rather than a loop.
EDIT#1:
Based on Banana's suggestion:
Sub FindTotalValue()
Dim rng As Range, cel As Range
For Each cel In ActiveSheet.UsedRange.Cells.SpecialCells(2)
If InStr(cel.Value, "Total") > 0 Then
MsgBox cel.Offset(0, 1).Value
Exit For
End If
Next cel
End Sub
EDIT#2:
To use Find():
Sub FindTotalValueQuickly()
MsgBox Cells.Find(what:="Total", lookat:=xlPart).Offset(0, 1).Value
End Sub
Data
Purpose is to highlight the non date cell based on column header.
(highlight the screenshot cell C3,c5,D2,D6)
The below code I try to work for the purpose but fail.
Could please help to see what i can change?
Sub colortest()
Dim MyPage As Range, currentCell As Range
With Sheets(2).Rows(1)
Set t = .Find("Cut Date", lookat:=xlPart)
Set A = Columns(t.Column).EntireColumn
For Each currentCell In A
If Not IsEmpty(currentCell) Then
Select Case Not IsDate(currentCell.Value)
Case 1
currentCell.Interior.Color = 56231
End Select
End If
Next currentCell
End With
End Sub
Or
Option Explicit
Public Sub colortest()
Dim MyPage As Range, currentCell As Range, t As Range, findString As String
findString = "Date"
With ThisWorkbook.Worksheets("Sheet2")
Set t = .Rows(1).Find(findString, LookAt:=xlPart)
Dim currMatch As Long
For currMatch = 1 To WorksheetFunction.CountIf(.Rows(1).Cells, "*" & findString & "*")
Set t = Rows(1).Find(What:=findString, After:=t, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If t Is Nothing Then Exit Sub
For Each currentCell In Intersect(.Columns(t.Column), .UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1, 0))
If Not IsEmpty(currentCell) And Not IsDate(currentCell.Value) Then currentCell.Interior.Color = 56231
Next currentCell
Next currMatch
End With
End Sub
Purpose is to highlight the non date cell based on column header.
(highlight the screenshot cell C3,c5,D2,D6)
this would do that:
Sub colortest()
Dim currentCell As Range, f As Range
Dim fAddress As String
With Sheets(2).Rows(1)
Set f = .Find(what:="Date", lookat:=xlPart, LookIn:=xlValues)
If Not f Is Nothing Then
fAddress = f.Address
Do
With Intersect(f.EntireColumn, .Parent.UsedRange)
For Each currentCell In .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeConstants, xlTextValues)
If Not IsDate(currentCell.Value) Then currentCell.Interior.Color = 56231
Next
End With
Set f = .FindNext(f)
Loop While f.Address <> fAddress
End If
End With
End Sub
Try this (untested)
Option Explicit
Public Sub ColorTest1()
Dim ur As Range, hdrRow As Range, hdr As Range, dtCol As Range, cel As Range
Set ur = ThisWorkbook.Worksheets(2).UsedRange
Application.ScreenUpdating = False
Set hdrRow = ur.Rows(1)
For Each hdr In hdrRow.Cells
If InStr(1, hdr.Value2, "date", vbTextCompare) > 0 Then '<- Date Header
Set dtCol = ur.Columns(hdr.Column).Offset(1) '<- Date column
For Each cel In dtCol.Cells
If Len(cel) > 0 Then 'If cell is not empty
If Not cel Is Error Then 'If not Error (#N/A, #REF!, #NUM!, etc)
If Not IsDate(cel) Then cel.Interior.Color = 56231
End If
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub
Try this:
Sub HighlightNonDate()
'simple function invocations
CheckColumn (3)
CheckColumn (4)
End Sub
Function CheckColumn(columnNumber As Long)
Dim lastRow As Long
lastRow = Cells(Rows.Count, columnNumber).End(xlUp).Row
'loop through column, start from 2 to omit headers
For i = 2 To lastRow
'if cell isn't a date, then color red
If Not IsDate(Cells(i, columnNumber)) Then
Cells(i, columnNumber).Interior.Color = RGB(255, 0, 0)
End If
Next
End Function
I am having an issue creating a macro that will autofill a VBA function named "FindMyOrderNumber". Every time I run a macro to Autofill "FindMyOrderNumber" only the first cell in the column is populated.
This function will look up an order number in column A (A1) and return the name of the worksheet it can be found B (B1).
Option Explicit
Function FindMyOrderNumber(strOrder As String) As String
Dim ws As Worksheet
Dim rng As Range
For Each ws In Worksheets
If ws.CodeName <> "Sheet3" Then
Set rng = Nothing
On Error Resume Next
Set rng = ws.Cells.Find(What:=strOrder, LookAt:=xlWhole)
On Error GoTo 0
If Not rng Is Nothing Then
FindMyOrderNumber = ws.Name
Exit For
End If
End If
Next
Set rng = Nothing
Set ws = Nothing
End Function
I created this macro to enter my VBA function "=findmyordernumber(a1)" in cell B1 then to Autofill column B.
Sub AutofillVBAFunction()
Range("B1").Select
ActiveCell.FormulaR1C1 = "=FindMyOrderNumber(RC[-1])"
Selection.Autofill Destination:=Range("B1:B68")
Range("B1:B68").Select
End Sub
After I run this macro only B1 is populated.
Sorry if this has been discussed I am new and I tried How to fill-up cells within a Excel worksheet from a VBA function? and other questions and I could not apply it to my issue.
Please help
Add application.volatile to the function, that way it will calculate as the sheet changes.
Function FindMyOrderNumber(strOrder As String) As String
Dim ws As Worksheet
Dim rng As Range
Application.Volatile
For Each ws In Worksheets
If ws.CodeName <> "Sheet3" Then
Set rng = Nothing
On Error Resume Next
Set rng = ws.Cells.Find(What:=strOrder, LookAt:=xlWhole)
On Error GoTo 0
If Not rng Is Nothing Then
FindMyOrderNumber = ws.Name
Exit For
End If
End If
Next
Set rng = Nothing
Set ws = Nothing
End Function
It also wouldn't hurt to calculate the sheet when You add the formula to the range.
Sub Button1_Click()
Dim Rws As Long, Rng As Range
Rws = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, 2), Cells(Rws, 2))
Rng = "=FindMyOrderNumber(RC[-1])"
End Sub
I've written some simple code that matches cells in one worksheet to cells in another, and then deletes the entire row if the cells are equal.
The code selects rows properly, but for some reason refuses to actually delete the rows in my worksheet. EDIT: Some of the rows delete. Others don't, even though they have the exact same values as those that did delete. If anyone can help that would be greatly appreciated.
Sub delFunds()
Dim fCell As Range 'Fund cell
Dim fRng As Range 'Fund range
Dim wCell As Range 'Working sheet cell
Dim wRng As Range 'Working sheet range
Dim n As Long
Set fRng = Worksheets("Funds").Range("C2:C117")
Set wRng = Worksheets("Working sheet").Range("I3:I7483")
For Each fCell In fRng.Cells 'Loop through all funds
For Each wCell In wRng.Cells 'Loop through all working cells
If StrComp(wCell.Value, fCell.Value, vbTextCompare) = 0 Then 'If equal then delete
n = wCell.Row
Rows(n & ":" & n).Select
Selection.Delete Shift:=xlUp
End If
Next wCell
Next fCell 'Go to next fund
End Sub
I would use this code without nested loop:
Sub delFunds()
Dim rngToDel As Range
Dim fRng As Range 'Fund range
Dim wCell As Range 'Working sheet cell
Dim wRng As Range 'Working sheet range
Set fRng = Worksheets("Funds").Range("C2:C117")
Set wRng = Worksheets("Working sheet").Range("I3:I7483")
For Each wCell In wRng 'Loop through all working cells
' if wCell found in Fund range then delete row
If Not IsError(Application.Match(Trim(wCell.Value), fRng, 0)) Then
If rngToDel Is Nothing Then
Set rngToDel = wCell
Else
Set rngToDel = Union(rngToDel, wCell)
End If
End If
Next wCell
If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
End Sub
I know #simoco's answer works and has been accepted already, but I love a good question so I wanted to pull together a solution using the autofilter to kill big swaths of the working sheet at once. I figured your design might look like this:
From there, you can loop through the concise fund list and filter the working sheet on each fund:
Option Explicit
Sub EliminateWorkingDuplicates()
Dim WorkingSheet As Worksheet, FundSheet As Worksheet
Dim FundRange As Range, WorkingRange As Range, _
Fund As Range
Dim LastRow As Long, LastCol As Long, _
WorkingFundCol As Long
'assign sheets and ranges for easy reference
Set WorkingSheet = ThisWorkbook.Worksheets("Working sheet")
Set FundSheet = ThisWorkbook.Worksheets("Funds")
Set FundRange = FundSheet.Range("C2:C117")
WorkingFundCol = 9 'column I on working sheet
'determine the bounds of the data block on the working sheet
LastRow = WorkingSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = WorkingSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set WorkingRange = Range(WorkingSheet.Cells(2, 1), WorkingSheet.Cells(LastRow, LastCol))
'start working through the funds and calling the autofilter function
For Each Fund In FundRange
Call FilterAndDeleteData(WorkingRange, WorkingFundCol, Fund.Value)
Call ClearAllFilters(WorkingSheet)
Next Fund
End Sub
'**********
'blow away rows
Sub FilterAndDeleteData(DataBlock As Range, TargetColumn As Long, Criteria As String)
'make sure some joker didn't pass in an empty range
If DataBlock Is Nothing Then Exit Sub
'execute the autofilter with the supplied column and criteria
With DataBlock
.AutoFilter Field:=TargetColumn, Criteria1:=Criteria
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub
'**********
'safely clear filters
Sub ClearAllFilters(TargetSheet As Worksheet)
With TargetSheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
End Sub
I want to select every column that has the word "TEST" in the 5th row range, and then select the cells below down to a certain amount.
I have can find and select the range I want, I just cant have all my selections when I finish, and I want them so I can do some conditional formatting.
Public Sub Macro1()
Dim n As Integer
n = 5
For Each c In Worksheets("Sheet1").Range("E5:UM5").Cells
If InStr(1, "TEST", "TEST") Then
Range(Cells(6, n), Cells(48, n)).Select
n = n + 1
End If
Next
End Sub
Do you think a array would help me to keep the data to then select after?
The code below is modified from user ooo answer here .
Is there a reason you need to select cells? In vba you can do most things without actually selecting cells which makes it quicker and less prone to errors.
If you do need to select the cells I would build up the range and then select it all at once at the end.
Gordon
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Dim newRng As Range
With Sheet1
Set rng1 = .Range("A1:A3")
Set rng2 = .Range("C3:C5")
Set newRng = Union(rng1, rng2)
set rng2 = .range("E5:E7")
set newRng = Union(newRng,rng2)
newrng.select
End With
End Sub
Applied to your code
Public Sub Macro1()
Dim n As Integer
dim rng as range
n = 5
For Each c In Worksheets("Sheet1").Range("E5:UM5").Cells
If InStr(1, "TEST", "TEST") Then
If rng Is Nothing Then
Set rng = Range(Cells(6, n), Cells(48, n))
else
set rng = union(rng, range(cells(6,n),cells(48,n)))
end if
n = n + 1
End If
Next
rng.select
End Sub
Public Sub Macro1()
Dim n As Integer, rng as Range, sht as WorkSheet
Set sht = Worksheets("Sheet1")
For Each c In sht.Range("E5:UM5").Cells
If c.value Like "*TEST*" Then
If rng is nothing then
Set rng = c.offset(1,0).Resize(43,1)
else
Set rng = Application.union(rng, c.offset(1,0).Resize(43,1))
end if
End If
Next
rng.select
End Sub
Public Sub Macro1()
Dim c As Range, rng As Range, ws As Worksheet
Set ws = Worksheets("Sheet1")
For Each c In ws.Range("E5:UM5").Cells
If InStr(c, "TEST") Then
If rng Is Nothing Then
Set rng = c
Else
Set rng = Application.Union(rng, c)
End If
End If
Next
If Not rng Is Nothing Then
rng.Select
Debug.Print rng.Address
Else
Debug.Print "Not found"
End If
End Sub