I have a spreadsheet which contains 4 general lines constant in every quote. Depending on the # of line items in the quote the rows where these 4 general lines occur varies. I am trying to find a code which locates the words "SHOP TICKETS" in column B and then deletes that row and the 3 below it without containing a loop. The loop is not needed and seems to bog it down. I have been at this for 2 days, and I can't seem to find the right code.
I've tried For Each, With, Find, a whole bunch of solutions I have found online, but none seem to work right. except a Dim one but it slowed it down so much it wasn't worth keeping. I'm new/self taught so please be patient with me.
Sub delete
With WorkSheets("Sheet1") 'Change to your sheet
Dim rw as Long
On Error Resume Next
rw = Application.WorksheetFunction.Match("SHOP TICKETS",.Range("B:B"),0)
On Error Goto 0
If rw > 0 Then
.Range(rw & ":" & rw + 3).entirerow.delete
End if
End with
End sub
Cells.Find(What:="SHOP TICKETS", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Set rng = Range(ActiveCell, ActiveCell.Offset(3, 0))
rng.EntireRow.Delete
I got it!! Thanks. Talking it through to a group helped.
Related
I need Excel to delete columns as long as the header is NOT "Event Notes."
For related purposes, I found and successfully used the InStr function to find certain headers and delete the columns. But now I just want it to, starting at the end, delete columns until it finds THE EXACT STRING "Event Notes."
So far, I've had it delete EVERYTHING that didn't contain Event Notes; now it's finding "Event Notes Dates" and exiting the For loop.
Thanks a bunch for any assistance!
For iCounter = myWorksheet.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column To 1 Step -1
If InStr(1, myWorksheet.Cells(1, iCounter).Value, "Event Notes") = 1 Then
Exit For
Else
myWorksheet.Columns(iCounter).EntireColumn.Delete
End If
Next iCounter
following my comment, you should simply compare the range value to the "target" one
As per this little revision of your code
With myWorksheet ' reference your sheet.
For iCounter = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column To 1 Step -1
If .Cells(1, iCounter).Value = "Event Notes" Then
Exit For
Else
.Columns(iCounter).EntireColumn.Delete
End If
Next iCounter
End With
I am trying to do a find and replace in excel but excel is not finding anything and i think it is due to the amount of characters as there are some that have around 30,000 and for example find Don't and replace with Dont.
I want to insert this data into SQL and this is why i am trying to remove all the single quotes, there are many Q and A's on find and replace but i cant find anything that works for the amount of characters my data has.
I am terrible at VBA and so i don't really have any code to share except the below which doesn't work.
Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Thanks to #Naresh who answered this.
Sub FindString()
Dim c As Range
Dim firstAddress As String
With Worksheets(1).Range("A1:a10")
Set c = .Find("'", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = Replace(c.Value, "'", "quotechanged")
Set c = .FindNext(c)
Loop While Not c Is Nothing
End If
End With
End Sub
I used record macro to create some code and then I put it in a loop. It works but there is an error in the find function which causes it to only work once. I tried to do something with the error but I am not having any luck having it loop. I've looked a couple of days here and there but I am at a loss. Hope you can help me. Much appreciated.
i = 1
On Error GoTo notfound
Do While Sheet1.Cells(i, 1) <> ""
Columns("J:J").Select
Selection.Find(What:="x", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Rows(ActiveCell.Row).EntireRow.Delete
notfound: msgbox "Finished"
GoTo notfound
Exit Sub
i = i + 1
Loop
I've corrected, completed, formatted and commented your code. This should take you one step closer to what you want to do.
Private Sub Sample()
Dim Crit As Variant ' the criterium to look for
Dim Fnd As Range ' the cell to find
Dim i As Long
' never create an error handler if you don't know which error to exect
' On Error GoTo notfound
i = 1
' the cell can't be "" only its value can do thjat
Do While Sheet1.Cells(i, 1).Value <> ""
Crit = "x"
' Columns("J:J").Select
' don't Select anything, address cells or ranges instead
Set Fnd = Columns("J:J").Find(What:=Crit, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
' where is the 'Activecell'?
' a) it doesn't change while this loop is running
' but it might get deleted by this loop's action
' b) it must be in the range you are searching
' that's why your code will fail most of the time.
' don't Activate anything. Instead address the object you want to deal with.
If Fnd Is Nothing Then
MsgBox "I didn't find """ & Crit & """"
Else
Sheet1.Rows(Fnd.Row).EntireRow.Delete
End If
i = i + 1
Loop
End Sub
This code will look for "x" in column J for as long as there is a value in column A and delete the row where it is found. It's hard to imagine a relationship between the number of entries in column A and the number of "x" in column J but, hopefully, this isn't your problem. Instead, your obvious problem is the cell in which you want to start the search. It definitely isn't ActiveCell but it might be Cells(1, "J"). You can also omit this instruction and VBA will start the search after J1.
You want to LookIn formulas. If there are formulas in column J the Formula will be different from the Value. You may wish to search in xlValues.
What I want:
I've got a lot of sheets whith different devices. Let's call one of these sheets "WS1".
And I've got a seperate sheet with all existing devices and the appropriate OS next to it. This one we call "list".
Now I want the other sheets (e.g. the "WS1") to check the "list", find the right device, and copy the right OS into the WS1-sheet.
the manual way would be:
select cell "C3" of WS1 and copy it.
open the "list"-Sheet and find the copied entry
select the cell left to the found entry and copy it
open the WS1 again, select the left cell right next to the active cell and paste the new clipboard (which contains the OS)
select the next cell which is under and on the right side of the active cell.
loop until every device in WS1 is filled with an OS
What I've got so far:
Dim DataObj As New MSForms.DataObject
Dim strCliBoa As String
'strCliBoa = DataObj.GetText
DataObj.GetFromClipboard
Range("C3").Select
Selection.Copy
strCliBoa = DataObj.GetText
Sheets("list").Select
Range("A1").Select
Cells.Find(What:=strCliBoa, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Select
Selection.Copy
strCliBoa = DataObj.GetText
Sheets("WS1").Select
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 1).Select
My issue:
"Runtime Error 91: Object variable or with block variable not set"
and it marks the cells.find-method.
Can someone tell me what I'm doing wrong?^^
Thanks in advance!
(oh, almost forgot: I'm using ms excel 2010 on Win7)
If the string you're looking for isn't found you'll get that error. The find function returns "Nothing" if nothing is found
Dim r As Range
Set r = Cells.find(What:=strCliBoa, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If r Is Nothing Then
'handle error
Else
'fill in your code
End If
I'll provide you an answer using the VLOOKUP() function. So Sheet1 contains several devices and I need to find the correct OS. Sheet2 contains the matching between device and OS.
On Sheet1 enter this formula in the cell next to device and pull it down (of course edit to your specific needs).
=VLOOKUP(A2;Sheet2!$A$1:$B$20;2;0)
EDIT: the VLOOKUP function will only work if the OS is in second column. Either switch around the columns or use a helper column at the end to contain the OS.
In the sheet where you have the Device name (WS1) put formula:
=INDEX(List!$A$2:$B$10;MATCH('WS1'!C3;List!$B$2:$B$10;0);1)
Where :
List!$A$2:$B$10 is a range where you have the Devices + OS in the list
'WS1'!C3 is the Device you want to search for in the list ("WS1" in your case)
List!$B$2:$B$10 is the column on Sheet List, where the devices are listed.
Edit 1 - VBA code
If you want to use VBA then use this :
Sub FindDevicePasteOS()
'Find corresponding OS for the device
Dim intRow As Integer
Dim wsht As Worksheet
For Each wsht In Worksheets
If wsht.Name <> "List" Then 'add more sheets you want to exclude using OR (e.g. ... Or wsht.Name <> "Cover Sheet" Then)
For intRow = 3 To wsht.Cells(Rows.Count, 3).End(xlUp).Row 'presuming there is nothing else in the column C below the devices
If Not Worksheets("List").Cells.Find(what:=wsht.Cells(intRow, 3)) Is Nothing Then
wsht.Cells(intRow, 2) = Worksheets("List").Cells.Find(what:=wsht.Cells(intRow, 3)).Offset(0, -1)
End If
Next intRow
End If
Next wsht
End Sub
So I used a psuedo solution where I added the If x is nothing block to the code to skip over the err'd pieces. I was able to process about 80% of the data which is good for me. I still can't understand why Find would return nothing.
Another interesting and maybe related problem occurred in a different computer running the same macro - after I ran into this problem a few times, my computer gave me a blue screen with a 'thread stuck in driver' message. Could they be related? Excel processing to much to fast and get's mixed in the thread processing?
Food for though, I dunno why the find won't just work every-time.
In Sobigen post I had to switch the part LookAt:=xlPart to LookAt:=xlWhole to get it to work because If r Is Nothing Then was throwing an error when it found partial matches. Other than that the code worked great thanks!
I have a macro that's met to find all the rows in the N column in an excel spreadsheet with a value of 'Accept', and adjust their value to 'Reject'.
My macro is working, but it works VERY slow, it literally took me over 15 minutes for my macro to run through 20,000+ rows changing the cell value from Accept to Reject, which is way too long for me to expect any customer to wait (20,000 is the high end of how many rows of data I'd expect customers to have).
Below is the code in my macro, I'm wondering if anyone has any ideas how I can make it run faster.
' Select cell N2, *first line of data*.
Range("N2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value = "Accept" Then
ActiveCell.Value = "Reject"
End If
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
Thanks for all the help guys. I used some of the links and code you guys posted (especially the link Doug Glancy posted in a comment, wish I could pick comments as the accepted answer) to come up with some new code that works almost instantly. For anyone who's interested in how it's working, here's the new VBA code.
Dim dat As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("N2:N" & ActiveSheet.UsedRange.Rows.Count)
dat = rng ' dat is now array
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) = "Accept" Then
dat(i, 1) = "Reject"
End If
Next
rng = dat ' put new values back on sheet
The following has worked very fast for me in the past:
Have macro select area/range that needs to have values replaced.
Selection.Replace What:="Accept",Replacement:="Reject", LookAt:=xlPart, SearchOrder:=xlByRows,MatchCase:=True,SearchFormat:=False,ReplaceFormat:=False
Try this:
Sub formatnumbers()
Do Until IsEmpty(ActiveCell)
ActiveCell.Select
ActiveCell.Replace What:=ActiveCell.Value, Replacement:=ActiveCell.Value, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveCell.Offset(2000, 0).Select
Loop
End Sub