In column 'G' of my worksheet I have cells with the text 'Months Billed' - I have code which searches for this text and in the cell next to the text increments the value by 1.
I found the code on this site but for some reason I get a run-time error 13 - Type Mismatch after it has changed all of the values. EDIT - I did a step into, once the code has run through column G and changed all of the values, it loops back to the For Each statement and then I get the run-time error at the found.offset statement.
Here is my code:
Sub UpdateMonthsBilled()
Dim findRng As Range, _
targetRng As Range, _
findCell As Range, _
found As Range
Dim firstFound As String, _
columnName As String
Dim Month As Integer
Month = 1
columnName = "G"
Set findRng = Range("G5:H650")
For Each findCell In findRng
Set targetRng = Range(columnName & "2", Range(columnName & Rows.Count).End(xlUp))
With targetRng
Set found = .Find(findCell.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not found Is Nothing Then
firstFound = found.Address
Do
found.Offset(0, 1).Value = found.Offset(0, 1).Value + 1
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstFound
End If
End With
Next findCell
End Sub
Any help would be appreciated as I have no idea where I am going wrong?
I copied your code to VBA, and ran it.
It seems that rows G1 through G4 are being incremented as well.
No errors, however. This is Excel 2003.
Related
My question is in the title. I have searched up everywhere and this one feels like the only answer that is working:
https://stackoverflow.com/a/15180079/17038705
I have created a sample Excel file and validated that his VBA code works, the sample he shows looks like it is working too. However, when I ran it with the Excel file I am working on, I got Error 91, Object variable or With block variable not set.
After some digging, it is probably because of his Find() function that returns Nothing.
My question is why this is the case for my file and not for others. The values there are based on formulas and values of other cells, would that be a problem?
Other approaches are appreciated as well. Thanks!
Since your data contains formulas, you need to set the LookIn parameter to xlValues in the Find method. I updated the original code with these changes, take a look:
Sub Highlight_Duplicate_Entry()
Dim ws As Worksheet
Dim cell As Range
Dim myrng As Range
Dim clr As Long
Dim lastCell As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
Set myrng = ws.Range("A2:D" & Range("A" & ws.Rows.Count).End(xlUp).Row)
With myrng
Set lastCell = .Cells(.Cells.Count)
End With
myrng.Interior.ColorIndex = xlNone
clr = 3
For Each cell In myrng
If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
' addresses will match for first instance of value in range
'[================]
If myrng.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then
' set the color for this value (will be used throughout the range)
cell.Interior.ColorIndex = clr
clr = clr + 1
Else
' if not the first instance, set color to match the first instance
'[================]
cell.Interior.ColorIndex = myrng.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
End If
End If
Next
End Sub
A slightly different approach using a Dictionary to track values vs. colors:
Sub Tester()
ColorDups Range("A1").CurrentRegion
End Sub
Sub ColorDups(rng As Range)
Dim c As Range, dict As Object, i As Long, v
Set dict = CreateObject("scripting.dictionary")
i = 0
Application.ScreenUpdating = False
For Each c In rng.Cells
v = CStr(c.Value)
If Len(v) > 0 Then
If Not dict.exists(v) Then
dict.Add v, c 'store the first cell with this value
Else
If TypeOf dict(v) Is Range Then 'second cell with this value?
i = i + 1 'next index
dict(v).Interior.ColorIndex = i 'color the first cell
dict(v) = i 'store the index
End If
c.Interior.ColorIndex = dict(v) 'color this duplicate
End If
End If
Next c
End Sub
I am new to Vba(and coding in general) and have written a very basic macro to find out "wood" inside a particular column from a larger set of data, however when I try to run it, it's still searching from the whole data set instead of the specified column.
I started with keeping the range of Cel to the whole data set, and then just narrowed it to the third column. However, when I remove the find element the immediate window shows me the address of cells in the third column, just as I want, but as soon as I use Find, it searches through the whole dataset.
I've tried defining propertied in Find object such as After and SearchOrder, but then it shows an error.
Dim emptyrow As Long
emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
Dim Cel As Range
Dim n As Integer
Set Cel = Range("C2:C54")
For n = 2 To emptyrow
Debug.Print (Cel.Cells(n,3).Find("wood","C2",,,xlByColumn).Address)
Next n
On using properties of Find, I get a type mismatch error.
It's not clear what exactly you want to do with the results, but here are a couple of possible outputs.
Sub xx()
Dim rFind As Range, s As String, v() As Variant, i As Long
With Range("C2:C54")
Set rFind = .Find(What:="Wood", After:=.Cells(.Cells.Count), _
Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
s = rFind.Address
Do
Debug.Print rFind.Offset(, -2).Value 'column A value in immediate window
i = i + 1
ReDim Preserve v(1 To i)
v(i) = rFind.Offset(, -2).Value 'or store values in an array
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> s
End If
End With
MsgBox Join(v, ", ")
End Sub
Use this:
Sub fnd_all_wood()
Dim c As Range
Dim firstaddress As String
With Range("C2:C54")
Set c = .Find("wood", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Debug.Print c.Address
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstaddress
End If
DoneFinding:
MsgBox "Done All"
End With
End Sub
This will print all the Cell Address in Range C2:C54 where it finds Wood
More information about the Formula Range.FindNext in the Link.
Update:
You can change the line Debug.Print c.Address to any other code where you can get the row by c.row and use it to get the other values like cells(c.row,1) to get the value from Ist column.
Demo:
Would like to have a column range searched for specific text ("REASON") and when found, have that entire cell content be filled onto a range of different cells.
This is done until a new "REASON" is found - in which case this cell content will be copied accordingly like before.
This is before result:
before
... and expected result, with filled text in J column
Thanks guys, been messing with this but not sure where to go from here:
Sub AddSus()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
cel.Offset(1, 0).Value = cel.Value
End If
Next cel
End Sub
There's a few things wrong with this. As you iterate through cel in SrchRng your conditional is checking the value of that cel to contain "REASON". This is not what you want. What you are essentially doing is checking for the "REASON" string and saying all entries below this, until the next reason, should be true for a conditional to populate column J.
Lets, really briefly, run through the logic of a single cell to illustrate why your code was not doing what you wanted:
In cell G3, you check to see if it contains the "REASON" string. It does not, so there is no assignment of any value anywhere. The following will do what you want:
Sub AddSus()
Dim SrchRng As Range, cel As Range, reasonString As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
reasonString = cel.Value
ElseIf cel.Value <> "" Then
cel.Offset(0, 3).Value = reasonString
End If
Next cel
End Sub
Minor note but if you are in column G and you want to populate column J, the offset should be .offSet(0,3).
Use FIND to quickly jump between instances of REASON:
Sub AddSus()
Dim SrchRng As Range
Dim rFound As Range
Dim lStart As Long, lEnd As Long
Dim sFirstAddress As String
Dim sReason As String
Set SrchRng = ThisWorkbook.Worksheets("Sheet1").Range("G:G")
'Find the first instance of REASON in column G.
Set rFound = SrchRng.Find(What:="REASON:", _
After:=SrchRng.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'Check something has been found before continuing.
If Not rFound Is Nothing Then
'Find just keeps looping unless you tell it to stop,
'so record the first found address.
sFirstAddress = rFound.Address
Do
'Save the reason and start row.
sReason = rFound.Value
lStart = rFound.Row
'Find the next REASON in column G.
Set rFound = SrchRng.FindNext(rFound)
If rFound.Address = sFirstAddress Then
'The first instance has been found again, so use column I to find last row of data.
lEnd = SrchRng.Offset(, 2).Cells(Rows.Count, 1).End(xlUp).Row
Else
lEnd = rFound.Row
End If
'Fill in from 2 rows down from Start and 2 rows up from End.
'This will go wrong if there's not enough space between REASONs.
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Cells(lStart + 2, 10), .Cells(lEnd - 2, 10)) = sReason
End With
Loop While rFound.Address <> sFirstAddress
End If
End Sub
A Quick and Dirty Solution...
Sub AddSus()
Dim SrchRng As Range, cel As Range
Dim reason As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
reason = cel.Value
End If
If cel.Column = 10 And Len(cel.Offset(,-1)) > 0 Then
cel.Value = reason
End If
Next
End Sub
I got little project in VBA and stuck on below topic.
I need to select range from searched value to first empty cell in H column.
Selected range should looks like this
Selected Range in Excel:
I searched for specific value in column A and if I found it it's being set as first cell in range. ( It works)
Then I need to find last cell in range which is first empty cell in last column.
This is what I've found and try to use
Sub Button()
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Worksheets("SS19").Activate
ActiveSheet.Range("A:A").Select
Set cell = Selection.Find(What:=StringToFind, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
cell.Select
With Worksheets("SS19")
Set rr = .Range(ActiveCell, .Cells(.Rows.Count, "H").End(xlUp))
With rr
rr.Parent.Range(.Cells(1, "A"), .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0)).Select
End With
End With
If cell Is Nothing Then
Worksheets("SS19").Activate
MsgBox "String not found"
End If
I tried to searched for first empty cell in prevously selected range so it won't search the whole column but it doesn't work.
Try this...
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
With ws
Dim findCel As Range
Set findCel = .Range("A:A").Find(StringToFind, , , xlWhole, , , False, , False)
Dim lRow As Long
lRow = .Range(findCel.Address).Offset(, 7).End(xlDown).Row + 1
Dim rr As Range
Set rr = .Range("A" & findCel.Row & ":" & "H" & lRow)
rr.Select
End With
I find that using the worksheet's match function is easier than Range.Find when searching a single column.
Option Explicit
Sub Button()
Dim stringToFind As String, m As Variant
Worksheets("SS19").Activate
stringToFind = Application.InputBox("Enter string to find", "Find string", Type:=xlTextValues)
With Worksheets("SS19")
m = Application.Match(stringToFind, .Range("A:A"), 0)
If Not IsError(m) Then
If Not IsEmpty(.Cells(m + 1, "H")) Then
.Range(.Cells(m, "A"), .Cells(m, "H").End(xlDown).Offset(1)).Select
Else
.Range(.Cells(m, "A"), .Cells(m, "H").Offset(1)).Select
End If
End If
End With
End Sub
Using .End(xlDown) could be problematic if the first cell under row m in column H was blank and this should be checked for or you might find the selection reaching too far, possibly all the way down to the bottom of the worksheet. Checking for a non-blank cell will catch this potential problem.
I am trying to create a macro in excel 2010 that finds every cell in a sheet with a value of "All Customers." Every time that value is found I need a blank row inserted below it. Thought it would be pretty simple but I have searched I many forums and tried to use some sample code and I can't get it to work properly. I am a complete newb when it comes to VBA stuff. Thought I would post here and go do some light reading on basics of VBA.
If anyone has any good training resources, please post those as well.
Thanks in advance!
EDIT: In my OP, I neglected to mention that any row that contains a value of "All Customers" would ideally be highlighted and put in bold, increased size font.
These actions are something that an old Crystal Report viewing/formatting program used to handle automatically when pulling the report. After we upgraded the program I learned that this type of formatting ability had been removed with the release of the newer version of the program, according to the software manufacturer's tech support. Had this been defined in the release notes I would have not performed the upgrade. Regardless, that is how I found myself in this macro disaster.
Something like this code adpated from an article of mine here is efficient and avoids looping
It bolds and increase the font size where the text is found (in the entire row, as Tim points out you should specify whether you meant by cell only)
It adds a blank row below the matches
code
Option Explicit
Const strText As String = "All Customers"
Sub ColSearch_DelRows()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim cel1 As Range
Dim cel2 As Range
Dim strFirstAddress As String
Dim lAppCalc As Long
Dim bParseString As Boolean
'Get working range from user
On Error Resume Next
Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", ActiveSheet.UsedRange.Address(0, 0), , , , , 8)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
'Further processing of matches
bParseString = True
With Application
lAppCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'a) match string to entire cell, case insensitive
'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)
'b) match string to entire cell, case sensitive
'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)
'c)match string to part of cell, case insensititive
Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)
'd)match string to part of cell, case sensititive
' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)
'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
If Not cel1 Is Nothing Then
Set rng2 = cel1
strFirstAddress = cel1.Address
Do
Set cel1 = rng1.FindNext(cel1)
Set rng2 = Union(rng2.EntireRow, cel1)
Loop While strFirstAddress <> cel1.Address
End If
'Further processing of found range if required
If bParseString Then
If Not rng2 Is Nothing Then
With rng2
.Font.Bold = True
.Font.Size = 20
.Offset(1, 0).EntireRow.Insert
End With
End If
End If
With Application
.ScreenUpdating = True
.Calculation = lAppCalc
End With
End Sub
Public Sub InsertRowAfterCellFound()
Dim foundRange As Range
Set foundRange = Cells.Find(What:="yourStringOrVariant", After:=ActiveCell) 'Find the range with the occurance of the required variant
Rows(foundRange.Row + 1 & ":" & foundRange.Row + 1).Insert 'Insert a new row below the row of the foundRange row
foundRange.Activate 'Set the found range to be the ActiveCell, this is a quick and easy way of ensuring you aren't repeating find from the top
End Sub
You may need to add error handling to the code as you will get an error if no cell with the specified value is found.
Assuming this is on the first sheet ("sheet 1"), here is a slow answer:
Sub InsertRowsBelowAllCustomers()
'Set your worksheet to a variable
Dim sheetOne as Worksheet
Set sheetOne = Worksheets("Sheet1")
'Find the total number of used rows and columns in the sheet (where "All Customers" could be)
Dim totalRows, totalCols as Integer
totalRows = sheetOne.UsedRange.Rows.Count
totalCols = sheetOne.UsedRange.Columns.Count
'Loop through all used rows/columns and find your desired "All Customers"
Dim row, col as Integer
For row = 1 to totalRows
For col = 1 to totalCols
If sheetOne.Cells(row,col).Value = "All Customers" Then
Range(sheetOne.Cells(row,col)).Select
ActiveCell.Offset(1).EntireRow.Insert
totalRows = totalRows + 1 'increment totalRows because you added a new row
Exit For
End If
Next col
Next row
End Sub
This function starts from the last row and goes back up to the first row, inserting an empty row after each cell containing "All Customers" on column A:
Sub InsertRowsBelowAllCustomers()
Dim R As Integer
For R = UsedRange.Rows.Count To 1 Step -1
If Cells(R, 1) = "All Customers" Then Rows(R + 1).Insert
Next R
End Sub
The error is because the worksheet was not specified in used range.
I have slightly altered the code with my text being in column AJ and inserting a row above the cell.
Dim R As Integer
For R = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Range("AJ" & R) = "Combo" Then Rows(R).Insert
Next R