I am trying to do some renaming and I do not want the code to run if the last 3 characters = pdf. Should be simple, but when I run the macro the renaming works fine but it deletes every cell that ends with pdf.
SearchChar = "pdf"
For Each bCell In rng.Cells
Select Case Len(bCell)
Case 2
If Right(bCell, 3) <> SearchChar Then 'This must be wrong
val = SearchSite & Left(bCell, 1) & "00" & Mid(bCell, 2, 1) & "1.pdf"
End If
End Select
bCell.Value = val
Next
Have you tried changing your If statement to check if the right 3 characters are pdf, then "nothing" else your code? Would be similar to:
If Right(bCell,3)=SearchChar Then
'Nothing
Else
val = SearchSite & Left(r, 1) & "00" & Mid(r, 2, 1) & "1.pdf"
bCell.Value=val
End If
My guess is that where the last 3 characters are pdf, val = nothing, so what is printed out is bCell.Value= nothing, so it deletes it. I moved that inside the else section.
You may try like this to rename selection items not ending with "pdf"
Set rng = Selection
SearchChar = "pdf"
Select Case n
Case 2
For Each r In rng
If Right(r, 3) <> SearchChar Then 'This must be wrong
r = SearchSite & Left(r, 1) & "00" & Mid(r, 2, 1) & "1.pdf"
End If
Next
End Select
Related
First off, ill give credit where credit is due. This is put together using code from u/Joe Was from Mr.Excel.com and exceltip.com.
Now that I have gotten that out of the way I am trying to create a search function that will search through my 9 sheet document in excel, to find a value that was typed into a search box. Then paste those values onto the first page of the workbook.
What do I need to change in my code to make it paste to the right place on the search page? I have tried changing things in the last loop because that is where I get the "Run-Time error 91. Object variable or with block variable not set".
I've googled that error, but variables always screw me up so that may be the problem.
The search page.
This is where the Debugger stops.
This is my code so far.
Sub Find_one()
'Find Function For ERF Spreadsheet'
'Type in Box, Press Button, Display the Results'
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
myText = Range("D5")
If myText = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search sheet1'
If ws.Name = "Sheet1" Then GoTo myNext
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)
'Found.EntireRow.Copy _
'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
myNext:
End With
Next ws
If Len(AddressStr) Then
Sheet8.Range("B18") = ws.Cells(x, 1)
Sheet8.Range("C18") = ws.Cells(x, 2)
Sheet8.Range("D18") = ws.Cells(x, 3)
Sheet8.Range("E18") = ws.Cells(x, 4)
Sheet8.Range("F18") = ws.Cells(x, 5)
Sheet8.Range("G18") = ws.Cells(x, 6)
Sheet8.Range("H18") = ws.Cells(x, 7)
Sheet8.Range("I18") = ws.Cells(x, 8)
Sheet8.Range("J18") = ws.Cells(x, 9)
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub
This is the original code for the last loop...
If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
Here, try this out. I redid how I interpreted the first section. I'm not entirely sure what you're trying to do with everything so let me know if this works or where it went wrong.
Sub FindOne()
Dim k As Integer
Dim myText As String, searchColumn As String
Dim totalValues As Long
Dim nextCell As Range
k = ThisWorkbook.Worksheets.Count
myText = Sheets(1).Range("D5").Value
If myText = "" Then
MsgBox "No Address Found"
Exit Sub
End If
Select Case ComboBox1.Value
Case "Equipment Number"
searchColumn = "A"
Case "Sequence Number"
searchColumn = "B"
Case "Repair Order Number(s)"
searchColumn = "D"
Else
MsgBox "Please select a value for what you are searching by."
End Sub
End Select
For i = 2 To k
totalValues = Sheets(i).Range("A65536").End(xlUp).Row
ReDim AddressArray(totalValues) As String
For j = 0 To totalValues
AddressArray(j) = Sheets(i).Range(searchColumn & j + 1).Value
Next j
For j = 0 To totalValues
If (InStr(1, AddressArray(j), myText) > 0) Then
Set nextCell = Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(i).Range("A" & j, "I" & j).Value
End If
Next j
Next i
End Sub
Also I have no clue what that second part of the code is supposed to be, so if you want to elaborate on the section with If Len(AddressStr) Then, I'd appreciate it because that really doesn't even work as an If...Then statement lol :)
I want to find out if a particular group of cells match another group of cells in a different sheet using VBA. In my case, I need to find out if the lastName, firstName cells match. In my solution that I came up with, I'm looping through the first table, getting the employee name. Then looping through the second table, getting the employee name. Then seeing if the two match up. This method is too costly and takes too long. Is there any better way to do this?
My first table contains 6 rows, my second table can contain 100+ rows. Too much time is wasted.
I was thinking about just searching down the entire column to see if the last name matches first, if it does, then go and see if the first name matches... but then again, there could be some people with the same last name..
Here is what I have so far.
For i = 2 To managerRows 'Looping through the Managers Table
empFirst = managerSheet.Cells(i, 1)
empLast = managerSheet.Cells(i, 2)
empName = (empLast & ", " & empFirst)
For j = 3 To assignRows 'Looping through the Assignments table
empLastAssign = assignSheet.Cells(i, 4)
empFirstAssign = assignSheet.Cells(i, 5)
empNameAssign = (empLastAssign & ", " & empFirstAssign)
'MsgBox (empNameAssign)
...
Conditional statement comparing names
...
Next j
Next i
I know I have no conditional statement, I didn't bother writing it because I knew this approach is not the best one.
I cannot add another column to concatenate the second sheets names because they are read from a database and kept in separate columns and last name and first name. Anyways, is there a way that I can concatenate the names without adding another column to the second sheet and try to find them that way? Does that make sense?
Find will only look in one column if I'm not mistaken. Can it look in two?
UPDATE
I'm able to get the first occurrence of the last name, but not the others. I've added another field to match. So there are three fields to match now. Last Name, First Name, and Project Name. So far, my code will only find the first occurrence and stay there. I think my order of the looping is wrong.
Here is what I have so far.
For i = 2 To managerRows 'Looping through the Managers Table
empLast = managerSheet.Cells(i, 1)
empFirst = managerSheet.Cells(i, 2)
empName = (empLast & ", " & empFirst)
projectName = managerSheet.Cells(i, 3)
managerLast = managerSheet.Cells(i, 4)
managerFirst = managerSheet.Cells(i, 5)
managerName = (managerLast & ", " & managerFirst)
Set findRow = assignSheet.Range(assignSheet.Cells(3, 4), assignSheet.Cells(assignRows, 4)) 'Set a range to look for Last Name
Set c = findRow.Find(empLast, LookIn:=xlValues) 'Find matching Last Name if it exists
If Not c Is Nothing Then 'Last Name found
Do Until c Is Nothing 'Is this in the wrong place?
If Cells(c.Row, 5) = empFirst Then 'If first name matches
If Cells(c.Row, 10) = projectName Then 'If project name matches. We found them
MsgBox ("Found: " & empLast & ", " & empFirst & ": Project: " & projectName & " : in: " & c.Row)
End If
End If
Set c = findRow.FindNext(c) 'Is this is the wrong place?
Loop
End If
Set c = Nothing 'Is this in the wrong place?
Next i
Take a look at 'Is this in the wrong place? for my new loop.
UPDATE 2: Solved
I have successfully filtered on three columns using find and findNext. With the help of some good answers. I will post the completed version. I had to add extra else statement into my filters in order to go to the next ling found. Hopefully others can learn from this, as there is no clear answer for filtering on three columns using find.
For i = 2 To managerRows 'Looping through the Managers Table
empLast = managerSheet.Cells(i, 1)
empFirst = managerSheet.Cells(i, 2)
empName = (empLast & ", " & empFirst)
projectName = managerSheet.Cells(i, 3)
managerLast = managerSheet.Cells(i, 4)
managerFirst = managerSheet.Cells(i, 5)
managerName = (managerLast & ", " & managerFirst)
'Focus Below this
Set findRow = assignSheet.Range(assignSheet.Cells(3, 4), assignSheet.Cells(assignRows, 4)) 'Set a range to look for Last Name
Set c = findRow.Find(empLast, LookIn:=xlValues) 'Find matching Last Name if it exists
If Not c Is Nothing Then 'Last Name found
Do Until c Is Nothing
If Cells(c.Row, 5) = empFirst Then 'If first name matches
If Cells(c.Row, 10) = projectName Then 'If project name matches. We found them
MsgBox ("Found: " & empLast & ", " & empFirst & ": Project: " & projectName & " : in: " & c.Row)
Set c = Nothing
Else
Set c = findRow.FindNext(c)
End If
Else
Set c = findRow.FindNext(c)
End If
Loop
End If
Next i
Instead of using two loops, you can use just the first one and utilize the find function. I believe it'll be faster for you.
For i = 2 To managerRows 'Looping through the Managers Table
empFirst = managerSheet.Cells(i, 1)
empLast = managerSheet.Cells(i, 2)
empName = (empLast & ", " & empFirst)
managerLast = managerSheet.Cells(i, 3)
managerFirst = managerSheet.Cells(i, 4)
managerName = (managerLast & ", " & managerFirst)
MsgBox (empName & ", " & managerName)
Set myRng = assignSheet.Range(assignSheet.Cells(3, 4), assignSheet.Cells(assignRows, 4)
Set c = myRng.Find(empName, lookin:=xlValues)
if Not c is Nothing Then 'you found last name, no look to see if first is a match
if assignSheet.cells(c.row, 5) = empFirst then 'if it is, do something
'do whatever you need to do here
else
firstAddress = c.Address
Do
Set c = myRng.FindNext(c)
if Not c is Nothing Then 'you found last name, no look to see if first is a match
if assignSheet.cells(c.row, 5) = empFirst then 'if it is, do something
'do whatever you need to do here
end if
end if
Loop While Not c Is Nothing And c.Address <> firstAddress
end if
end if
Next i
For more information on find, look here.
you only need to know if it is there... then use COUNTIFS like:
=COUNTIFS(A:A,"Name",B:B,"Lastname"....)
and if it is not 0 then there is a match.
For VBA it is
Application.Countifs(Range("A:A"),"Name",Range("B:B"),"Lastname"....)
If you have any questions left, just ask ;)
EDIT
... I need the row number that they exist in ...
You never said that! *angry face*... still, it is possible to do in a more or less fast way:
Sub test()
Dim val As Variant, rowNum As Variant
With Sheets("Sheet1")
val = Evaluate(Intersect(.Columns(1), .UsedRange).Address & "&"" --- ""&" & Intersect(.Columns(2), .UsedRange).Address)
rowNum = Application.Match("name" & " --- " & "firstname", val, 0)
If IsNumeric(rowNum) Then Debug.Print "Found at Row: " & rowNum Else Debug.Print "Nothing was found"
End With
End Sub
I usually use a dictionary or collection when looking for duplicates. In this way I only have to loop through each list one time.
Sub FindDuplicates()
Dim empFirst As String, empLast As String, empName As String
Dim assignSheet As Worksheet, managerSheet As Worksheet
Dim i As Long, lastRow As Long
Dim d
Set assignSheet = Sheet2
Set managerSheet = Sheet1
Set d = CreateObject("Scripting.Dictionary")
With managerSheet
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow 'Looping through the Managers Table
empFirst = .Cells(i, 1)
empLast = .Cells(i, 2)
empName = (empLast & ", " & empFirst)
If Not d.exists(empName) Then d.Add empName, i
Next
End With
With assignSheet
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow 'Looping through the Managers Table
empFirst = .Cells(i, 4)
empLast = .Cells(i, 5)
empName = (empLast & ", " & empFirst)
If d.exists(empName) Then
Debug.Print "Match Found", empName, "assignSheet Row:" & i, "managerSheet Row:" & d(empName)
End If
Next
End With
End Sub
I have a small suggestion as I am new to excel vba,
I like to update the some string in a particular cell(j,8) , where t is a string to be update ,t varies from 1 to 10 .
I like to update t value in "alt enter " in a specific cell
if the cell is already fill , I like to add new line
destlastrow = bsmWS.Range("A" & bsmWS.Rows.Count).End(xlUp).Row 'Checking the BSM/CMS/LDP/RCTA (Test Catalog)
For j = 2 To destlastrow
b = onlyDigits(bsmWS.Range("A" & j).value)
If InStr(b, "T") Or InStr(b, "") = 0 Then ' Check if it Test case or Test case ID
' do something
ElseIf InStr(b, "T") Or InStr(b, "D") Then
'do something
ElseIf InStr(b, "P") Or InStr(b, "D") Then
'do something
Else
iComp = StrComp(A, b, vbBinaryCompare)
Select Case iComp
Case 0
With tabWS
Inc value
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Range(.Cells(i, 2), .Cells(i, 3)).Copy .Range(.Cells(value, 8), .Cells(value, 9))
tabWS.Range("B" & i).Interior.ColorIndex = 4
End With 'tabWS
End Select
t = tabWS.Cells(value, 8).value
bsmWS.Cells(j, 8).value = t & vbCrLf
Exit For
End If
Next j
Above is my snippet. I want to update "t" value which I get it from another worksheet, want to update into another worksheet (j,8).
Can someone give a valuable suggestion , how to add new lines in (j,8)
More clarity:
If cell (5,8) has already a value
cell (5,8) = "Already a string"
How can I add a new line in the same cell
dim t as string
t= "new line add"
How I can add t value in the next line to cell(5,8)
To get a new line you can use vbNewLine instead of vbCrLf.
To add to the text already in the cell use you can do it like this
bsmWS.Cells(j, 8).value = bsmWS.Cells(j, 8).value & vbNewLine & t
I've created a small macro for inserting a hidden bookmark to a numbered paragraph
Sub blablabla()
Dim BkmrkName As String
ActiveDocument.Bookmarks.ShowHidden = True
Application.ScreenUpdating = False
heanum = InputBox("Enter Heading1 number", "List paragraph", "1")
Select Case Len(heanum)
Case 1
sPos1 = "00" & Left(heanum, 1)
Case 2
sPos1 = "0" & Left(heanum, 2)
Case 3
sPos1 = Left(heanum, 3)
End Select
ActiveDocument.ConvertNumbersToText
lisnum = Left(Selection, InStr(Selection, vbTab))
ActiveDocument.Undo
If IsNumeric(Left(lisnum, 1)) = True Then
lisnum = Left(lisnum, Len(lisnum) - 2)
Select Case Len(lisnum)
Case 3
sPos2 = "00" & Right(lisnum, 1)
Case 4
If Mid(lisnum, 2, 1) = Chr(46) Then
sPos2 = "0" & Right(lisnum, 2)
ElseIf Mid(lisnum, 3, 1) = Chr(46) Then
sPos2 = "00" & Right(lisnum, 1)
End If
Case 5
If Mid(lisnum, 2, 1) = Chr(46) Then
sPos2 = Right(lisnum, 3)
ElseIf Mid(lisnum, 3, 1) = Chr(46) Then
sPos2 = "0" & Right(lisnum, 2)
ElseIf Mid(lisnum, 4, 1) = Chr(46) Then
sPos2 = "00" & Right(lisnum, 1)
End If
Case 6
If Mid(lisnum, 3, 1) = Chr(46) Then
sPos2 = Right(lisnum, 3)
ElseIf Mid(lisnum, 4, 1) = Chr(46) Then
sPos2 = "0" & Right(lisnum, 2)
End If
Case 7
sPos2 = Right(lisnum, 3)
End Select
End If
ActiveDocument.Bookmarks.Add Name:=Chr(95) & sPos1 & Chr(95) & sPos2
Application.ScreenUpdating = True
End Sub
The user select a numbered paragraph and triggers the macro. Macro runs once per trigger and inserts a hidden bookmark with the name like _001_042 if the selection begins with "any_character".42. The first "001" is meant to depict a chapter number (i.e. "Chapter 1"), but could be any number and is determined by a user input through a message box. This macro works, though with each next numbered paragraph runs slower and slower. When I get to paragraph 1.100 it takes ~5 minutes (!!!) for macro to insert a single bookmark "_001_100".
Why does such a long latency happen? Is it possible to optimize the macro to run faster?
Many thanks in advance!
Avoid making useless changes to a document. That applies to manual editing, and it applies doubly to VBA code.
Your ConvertNumbersToText / Undo is as close to completely useless as it gets. Don't do such things. Word has an Undo buffer that you stress for no reason with this pointless edit. Despite being a wasteful no-op, you also destroy the user's ability to undo their own actions with this.
First off, you solve the problem of padding a string in the worst possible way, (multiple times!). Lets fix that.
Function PadLeft(ByVal value As String, length As Integer, Optional padding As String = " ")
PadLeft = String(Max(0, length - Len(value)), padding) & value
End Function
This function will pad any string to any given length. However, it depends on another utility function that will return the greater of two numbers.
Function Max(a As Long, b As Long) As Long
If b > a Then Max = b Else Max = a
End Function
Now, how about this code:
Sub SetParagraphBookmark()
Dim para As Range, _
paraNum As Long, headerNum As String, _
prefix As String, suffix As String
Set para = Selection.Paragraphs(1).Range
paraNum = para.ListFormat.ListValue
If paraNum Then
headerNum = InputBox("Enter Heading1 number", "List paragraph", "1")
If headerNum > "" Then ' otherwise the user clicked Cancel
prefix = PadLeft(headerNum, 3, "0")
suffix = PadLeft(paraNum, 3, "0")
ActiveDocument.Bookmarks.Add "_" & prefix & "_" & suffix, para
End If
Else
MsgBox "Please click on a valid list paragraph first.", vbInformation
End If
End Sub
This sets a bookmark that spans the entire paragraph the cursor is in, without moving the cursor or making any other changes to the document.
General notes:
Why would you ever write Chr(46) instead of "."?
Indent your code properly, this increases readability.
If you find yourself copy-pasting any section of code, you are already doing something wrong. If you need something complex done in two places, write a function.
Try breaking up the work you do into the smallest possible useful unit, like I did with PadLeft and Max. This allows re-using bits of your code elsewhere. You might want to place them into a separate Utilities module as well.
Set breakpoints in your code to see what's going on.
Word has a comprehensive object model. You can find out just about anything about the document by navigating around that object model without resorting to steamroller tactics like ConvertNumbersToText. Taking some time to pick the right property from the right object pays. There will be a lot documentation-reading involved, you'll just have to deal with that. Luckily the Microsoft documentation is superb.
It's most useful to enable the "Locals Window" and the "Immediate Window" in the VBA editor. It allows you to browse the objects you work with while you are in break mode, which helps to identify the properties you are looking for.
Last, but not least: Always, always, always have Option Explicit at the top of your modules. There is a setting in the VBA IDE's options for that ("Require variable declaration"). Enable it. Manually add that line to any module that does not have it. Fix the errors you get before you do anything else. (Disable the "Auto syntax check" feature while you are at it, this feature is counter-productive.)
This macro does it's job in only few seconds:
Sub AddBkmrkSmart()
Dim Author, Year As String
ActiveDocument.Bookmarks.ShowHidden = True
heanum = InputBox("Enter Heading1 number", "Heading1", "1")
Select Case Len(heanum)
Case 1
sPos1 = "H00" & Left(heanum, 1)
Case 2
sPos1 = "H0" & Left(heanum, 2)
Case 3
sPos1 = "H" & Left(heanum, 3)
End Select
'Debug.Print "sPos1: " sPos1
lisnum = Selection.Range.ListFormat.ListValue
'Debug.Print "Iteration 1 lisnum: " & lisnum
Select Case Len(lisnum)
Case 1
sPos2 = "L00" & Left(lisnum, 1)
Case 2
sPos2 = "L0" & Left(lisnum, 2)
Case 3
sPos2 = "L" & Left(lisnum, 3)
End Select
'Debug.Print "sPos2: " sPos2
ActiveDocument.Bookmarks.Add Name:= "_" & sPos1 & "_" & sPos2
End Sub
I suggest is as answer along with Tomalak's one.
I have the code of this macro which removes leading and trailing spaces in cells with text or numbers:
Sub LIMPIAR()
Dim i As Integer
For i = 2 To 20628
Cells(i, 7).Value = Trim(Cells(i, 6).Value)
Next
End Sub
However , there are cells which its content is " ". So I would like to convert that kind of cells to "". How Can I do that?
EDIT: I'm working with scraped data.
Maybe dealing with them like this can help:
If Len(Cells(i,6).Value) <= 2 Then Cells(i, 7).Value = "" End If
OR
If Cells(i,6).Value = " " Then Cells(i, 7).Value = "" End If
Not a very elagent solution, but I would make use of the split function and then reconcatenate the elements of the resulting array. Assuming your string is in cell A1,
mystring = ""
myarray = Split(Cells(1, 1), " ")
For i = LBound(myarray) To UBound(myarray)
If Trim(myarray(i)) <> "" Then
mystring = mystring & Trim(myarray(i)) & " "
End If
Next i
MsgBox Trim(mystring)
mystring should provide a string with just one space between words. You could put this code inside your loop.