The code below gives either Mismatch or Range error in Excel 2008. How do I fix it?
Sub PEC()
Dim PEC As String, result As Integer
PEC = Range("AE2:AE26848").Value
If PEC = "A.06" Then result = 1
Range("AO2:AO26848").Value = result
End Sub
Sub PEC()
For x = 2 to 26848
If Range("AE" & x) = "A.06" Then Range("AO" & x) = 1
Next x
End Sub
I recommend using the following code. It might seem more complicated, but it certainly does a better and more robust job. It is simply assigning your input and output ranges as SrcRng and DstRng. FIND method for ranges is a good way to check for specific values.
Sub PEC()
Dim SrcRng As Range
Dim DstRng As Range
Dim rcell As Range
Set SrcRng = Range ("AE2:AE26848")
Set DstRng = Range("AO2:AO26848")
Set rcell = SrcRng.Find(what:="A.06", after:=SrcRng.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rcell Is Nothing Then
DstRng.Value = 1
End If
End Sub
Related
I have the following code I use to go through a sheet and parse the information onto separate sheets based on the string [Start].
Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
Dim i As Long, rFind As Range, rFind1 As Range, rFind2 As Range, rFind3 As Range, rFind4 As Range, ws As Worksheet, s As String, s1 As String, s2 As String
s = "[Start]"
With Sheets("Full History File").Columns(1)
Set rFind3 = .Find(What:="[HistoryEnd]", LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
Set rFind = .Cells(Rows.Count, 1)
For i = 1 To WorksheetFunction.CountIf(.Cells, "*" & s & "*")
Set rFind = .Find(What:=s, After:=rFind, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
Set rFind1 = .Find(What:=s, After:=rFind)
Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Blasted " & i
If i = WorksheetFunction.CountIf(.Cells, "*" & s & "*") Then
Set rFind1 = rFind2.Offset(1)
End If
Range(rFind, rFind1.Offset(-1)).Copy ws.Range("A1")
End If
Next i
End With
Sheets("Blast Summary Sheet").Select
SheetNames
CommandButton6.Visible = True
Application.ScreenUpdating = True
End Sub
My problem is that the information I am working through has changed and I need to adapt the code to do the following:
Search for the string [TrainingModeChanged]
If not found search for the string [TrainingMode]
If not found search for the string [Start]
Once any of the strings are found create the new sheet Blasted with the number and copy the information between the found string up until the next found string which could be either one of the 3 above.
All help in modify the code to do this would be helpfull thanks
I am not entirely sure what you are after, but you could write a function that returns your required string instead of hardcoding it. Function below:
Option Explicit
Function getString() As String
'we will use On Error Resume Next to by pass the expected error if cannot find the string
On Error Resume Next
Dim searchRng As Range
Dim mySheet As Worksheet
Set mySheet = ThisWorkbook.Sheets("Full History File")
'search for first range
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingModeChanged]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
'reset error handling
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here first search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingMode]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here second search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[Start]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
End Function
And you call in your routine as:
s = getString()
And then continue on with your code..
I'm running into an issue and I can't figure it out. Questions with the same error seem to have a different issue.
I have the following code:
Option Explicit
Sub Bank_match()
Dim x As Range, y As Range
Dim FirstSheet As Worksheet, SecondSheet As Worksheet
Dim Txn_count_1 As Integer, Txn_count_2 As Integer
Dim i As Integer
Set FirstSheet = Worksheets("Sheet1")
Set SecondSheet = Worksheets("Sheet2")
With FirstSheet
Set x = Cells.Find(What:="Description", After:=Cells(1, 1), LookIn:=xlValues _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Txn_count_1 = Range(x.offset(1, 0), x.offset(1, 0).End(xlDown)).Count
End With
With SecondSheet
Set y = Cells.Find(What:="Description", After:=Cells(1, 1), LookIn:=xlValues _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Txn_count_2 = Range(y.offset(1, 0), y.offset(1, 0).End(xlDown)).Count
End With
For i = 1 To Txn_count_1
If FirstSheet.Range(x).offset(i, 1).Value = SecondSheet.Range(y).offset(i, 2).Value Or _
FirstSheet.Range(x).offset(i, 2).Value = SecondSheet.Range(y).offset(i, 1).Value Then
FirstSheet.Range(x.offset(i, 1)).EntireRow.Interior.ColorIndex = 6
SecondSheet.Range(y.offset(i, 1)).EntireRow.Interior.ColorIndex = 6
End If
Next i
End Sub
Effectively, I'm trying to iterate through bank statements and highlight the rows of transactions that appear on both sheets. My problem is that I get the error on the 'If statement' line.
At first I thought it might be my sheet references, but if I replace 'FirstSheet' and 'SecondSheet' with Worksheets("Sheet1") and Worksheets("Sheet2") respectively, I then get "Application-defined or object-defined error" on the same line. I get the same error if I also qualify the range with 'ThisWorkbook'.
Any thoughts?
Drop the FirstSheet.Range and SecondSheet.Range... x and y are already range objects:
If x.Offset(i, 1).Value = y.offset(i, 2).Value...
Though you need to check if the Find was successful... otherwise x or y might be Nothing... using the following:
If Not x Is Nothing Then ' and similarly for y
And you are missing a period . before Cells and Range
Set x = .Cells
Set y = .Cells
Txn_count_1 = .Range(...
Txn_count_2 = .Range(...
I'm super new to VBA and hoping I could get some help please ... I'm looking for a succinct way to remove rows from a sheet via Macro and the VBA samples I've tried I cant get to work. I'm hoping it's something simple :)
The macro would remove a row that DOES NOT contain a specific values (from a specific column) from within an array. I sort of had it working, and full disclosure, I've borrowed code from other examples. The latest sample I'm working with just deletes everything, the other sample I was working with deleted Acro32.exe, but kept everything else. So not yet arrived at a solution.
Background: I have a CSV output from an application auditing tool, which spits out tonnes of app data from various computers. That CSV data will be copied into my master 'reporting' spreadsheet. I am only interested in reviewing and keeping data about specific applications, namely Chrome.exe, Firefox.exe, Acro32.exe and Winword.exe. The application name is always found in Column F. So, any cell contents found in Column F, that DOES NOT contain a value in an array, that entire row needs to be deleted. Ideally :) and the remaining rows will only include apps I'm interested in as defined in the array.
Any thoughts would be appreciated.
Thanks
Public Function GetLastRow(ByVal rngToCheck As Range) As Long
Dim rngLast As Range
Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastRow = rngToCheck.Row
Else
GetLastRow = rngLast.Row
End If
End Function
Sub Apps_Formatting()
Dim varList As Variant
Dim lngLastRow As Long, lngCounter As Long
Dim rngToCheck As Range, rngFound As Range
Dim rngToDelete As Range, rngDifferences As Range
Dim blnFound As Boolean
Application.ScreenUpdating = False
With ActiveSheet
lngLastRow = GetLastRow(.Cells)
'we don't want to delete our header row
Set rngToCheck = .Range("A2:A" & lngLastRow)
End With
If lngLastRow > 1 Then
With rngToCheck
'any Cell in Column F that contains one of these values are KEPT
'and if not found in cell, then the entire row is deleted.
varList = VBA.Array("Chrome.exe", "Firefox.exe", "Acro32.exe")
For lngCounter = LBound(varList) To UBound(varList)
Set rngFound = .Find( _
what:=varList(lngCounter), _
Lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=True)
'check if we found a value we want to keep
If Not rngFound Is Nothing Then
blnFound = True
'if there are no cells with a different value then
'we will get an error
On Error Resume Next
Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)
On Error GoTo 0
If Not rngDifferences Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngDifferences
Else
Set rngToDelete = Application.Intersect(rngToDelete, rngDifferences)
End If
End If
End If
Next lngCounter
End With
If rngToDelete Is Nothing Then
If Not blnFound Then rngToCheck.EntireRow.Delete
Else
rngToDelete.EntireRow.Delete
End If
End If
Application.ScreenUpdating = True
End Sub
To follow up on this thread, should someone else benefit, the code below was provided and worked really well.
Sub a1077712b()
'https://www.mrexcel.com/forum/excel-questions/1077712-vba-remove-rows-xlsx-where-particular-text-can-found-within-cell.html
Dim i As Long, r As Range
Dim va As Variant, arr As Variant, flag As Boolean
arr = Array("Chrome.exe", "Firefox.exe", "Acro32.exe", "Winword.exe")
Set r = Range("F2", Cells(Rows.count, "F").End(xlUp))
va = r
For i = 1 To UBound(va, 1)
flag = False
For Each x In arr
If InStr(1, va(i, 1), x, 1) > 0 Then flag = True: Exit For
Next
If flag = False Then va(i, 1) = ""
Next
r = va
r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Dim Counter As Integer
Dim Maxhouse As Integer
Dim FindHouse As Range
Dim RangeVar As Range
Dim HousesRange As Range
For Counter = 1 To MaxHouse
ActiveSheet.Cells(16, 2 + Counter).Select
House = ActiveCell
With Sheets("Sheet1").Range("C:KP")
Set FindHouse = Cells.Find(What:=House, _
After:=Cells(17, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not FindHouse Is Nothing Then
If Counter = 1 Then
Set HousesRange = FindHouse
Else
Set RangeVar = FindHouse
Set HousesRange = Union(HousesRange, RangeVar)
End If
End If
End With
Next Counter
For Each RCell In HousesRange.Cells
Application.Goto RCell, True
Next RCell**
Now my problem is with the for loop which traverses through the named range 'HousesRange'
So lets say that HousesRange contains [2,5,9,10].
Here HousesRange is a subset of the row [1,2,3,4,5,6,7,8,9,10] in my Sheet
And lets assume that HousesRange was established through the order of [9,10,5,2] (through the 1st for loop with the union).
Now as I traverse through HousesRange with just rCells (the second for loop), it takes me to 9, 10, 5 then 2.
But I want it to take me to 2, 5, 9 then 10
Can some body shed some light to this?
I had always thought that named ranges are ALWAYS traversed through left to right and then top to bottom.
Thank you so much in advance
Ok this is the long way round, but it should work:
Instead of using Union build your list of found houses in a dictionary object.
Then sort the ranges using Bubblesort HouseRangeDic
You should finally be able to use it in the right order:
Dim Counter As Integer
Dim Maxhouse As Integer
Dim FindHouse As Range
Dim RangeVar As Range
Dim HousesRange As Range
'****** NEW **********
Dim foundHouseCount
foundHouseCount = 1
Dim HouseRangeDic
Set HouseRangeDic = CreateObject("Scripting.dictionary")
'*********************
For Counter = 1 To Maxhouse
ActiveSheet.Cells(16, 2 + Counter).Select
House = ActiveCell
With Sheets("Sheet1").Range("C:KP")
Set FindHouse = Cells.Find(What:=House, _
After:=Cells(17, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not FindHouse Is Nothing Then
HouseRangeDic.Add foundHouseCount, RangeVar '**** NEW ***
foundHouseCount = foundHouseCount + 1 '**** NEW ***
End If
End With
Next Counter
'**** NEW ***
Bubblesort HouseRangeDic
For i = 1 To HouseRangeDic.Count
Application.Goto HouseRangeDic(i), True
Next
'************
Sub Bubblesort(ByRef rangeDic)
Dim tempRange
For i = 1 To rangeDic.Count - 1
For j = i To rangeDic.Count
If rangeDic(i).Address > rangeDic(j).Address Then
Set tempRange = rangeDic(i)
Set rangeDic(i) = rangeDic(j)
Set rangeDic(j) = tempRange
End If
Next
Next
End Sub
See if this works for you. Notice my "After:=" is set to the LAST cell of the range, so the first find starts at the beginning of the range.
Sub loopCells()
Dim FindHouse As Range
Dim HousesRange As Range
Dim rcell As Range
Dim r As Range
Dim sAdd As String
Dim House As Long
Set r = Sheets("Sheet1").Range("$C$15:$K$20") 'change to suit
House = 11'change to suit
With r
Set FindHouse = .Find(What:=House, After:=r(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not FindHouse Is Nothing Then
sAdd = FindHouse.Address
Do
If HousesRange Is Nothing Then
Set HousesRange = FindHouse
Else
Set HousesRange = Union(HousesRange, FindHouse)
End If
Set FindHouse = .FindNext(FindHouse)
Loop While Not FindHouse Is Nothing And FindHouse.Address <> sAdd
End If
End With
For Each rcell In HousesRange
Application.Goto rcell
Next rcell
End Sub
I'm kind of new to VBA and am struggling to understand some of the syntax.
I have a range from a3:c13, for example, and I'd like to set it as a variable so I can pass it to vlookup later as a the table array. However, the range is defined by user input in terms of its size. It will always start in A3, it will always include columns A:C, but I don't know how far down it would go. In that case, I think I'd set it as:
With range("a3")
table_array = range(.cells(0,0), .End(xlDown).End(xlToRight)).Select
End With
However, that doesn't seem to work. I get a runtime error:
Run-time Error '1004': Method '_Default' of object 'Range' failed.
Assuming cols A, B, and C have the same number of rows:
Sub Macro1()
Set r = Range("A3")
Set table_array = Range(r, r.End(xlDown)).Resize(, 3)
End Sub
You can find the last row in Col A:C and then construct your range?
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim Rng As Range
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Range("A:C").Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
If Not LastRow < 3 Then
Set Rng = .Range("A3:C" & LastRow)
Debug.Print Rng.Address
Else
MsgBox "No Data found beyond A3"
End If
End With
End Sub