I have to following code snippet ...
Public Sub FindText(path As String, file As String)
Dim Found As Range
myText = "test("
MacroBook = ActiveWorkbook.Name
' Open the File
Workbooks.Open path & file, ReadOnly:=True, UpdateLinks:=False
For Each ws In Workbooks(file).Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlFormulas, _
LookAt:=xlPart, MatchCase:=False)
If Not Found Is Nothing Then
' do stuff
' ...
I see in the debugger that Found contains Error 2015! The sheet contains the text I want in the formula.
Any ideas why I'm getting the error?
Thanks
As follow up from comments to the Q, Error 2015 occurs because your formula in the sheet returns #VALUE! error. You can handle it using IsError:
If Not Found Is Nothing Then
If Not IsError(Found) Then
' do sth
End If
End If
You don't need to use 'Set' in your code. You only use this to assign a reference to an object. Try:-
For Each ws In Workbooks(file).Worksheets
With ws
Found = .UsedRange.Find(What:=myText, LookIn:=xlFormulas, _
LookAt:=xlPart, MatchCase:=False)
If Not Found Is Nothing Then
' do stuff
' ...
Hopefully this should work.
Related
BACKGROUND: I got a cool Array Formula and it works perfect in Excel. Now I'm trying to do the same formula, but with VBA. So I typed the Array Formula in a cell and recorded with a macro. The formula works perfect. The macro recorder gets me this:
Selection.FormulaArray = _
"=INDEX('[HOGARES ALBACETE.xlsx]21076'!C1,MATCH(MAX(IF(RIGHT('[HOGARES ALBACETE.xlsx]21076'!C1,LEN(R[-1]C)+2)=""["" &R[-1]C&""]"",'[HOGARES ALBACETE.xlsx]21076'!C2)),IF(RIGHT('[HOGARES ALBACETE.xlsx]21076'!C1,LEN(R[-1]C)+2)=""[""&R[-1]C&""]"",'[HOGARES ALBACETE.xlsx]21076'!C2),0),1)"
If I try to run the code above, I get error 1004. The sub has just that line. Nothing else.
After some researching I got into this:
VBA Run time error 1004: Unable to set the formulaarray property of the range class
Entering Long Array Formulas In VBA
So I splitted the formula into 2 parts:
Dim theFormulaPart1 As String
Dim theFormulaPart2 As String
Dim MiReemplazo As String
MiReemplazo = "cacota"
theFormulaPart1 = "=INDEX('[HOGARES ALBACETE.xlsx]21076'!C1,MATCH(MAX(IF(RIGHT('[HOGARES ALBACETE.xlsx]21076'!C1,LEN(R[-1]C)+2)=""["" &R[-1]C&""]"",'[HOGARES ALBACETE.xlsx]21076'!C2))," & MiReemplazo & ",0),1)"
theFormulaPart2 = "IF(RIGHT('[HOGARES ALBACETE.xlsx]21076'!C1,LEN(R[-1]C)+2)=""[""&R[-1]C&""]"",'[HOGARES ALBACETE.xlsx]21076'!C2)"
With ActiveSheet.Range(“F2”)
.FormulaArray = theFormulaPart1
.Replace MiReemplazo, theFormulaPart2
End With
And I get no errors, but the part .Replace MiReemplazo, theFormulaPart2 does nothing (I mean, the replace does not happen, but the code executes)
Also, tried with:
ActiveSheet.Range("F2").FormulaArray = theFormulaPart1
DoEvents
Cells.Replace What:=MiReemplazo, Replacement:=theFormulaPart2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
But nothing. So I'm kinda out of ideas.
Also, checked the lenght of both formulas strings (173,107). Do I need sorther strings?
THINGS I'M PRETTY SURE ARE NOT A PROBLEM:
The formula in Excel works if I type it manually. So is not a problem of the Formula itself
I'm just working in 1 cell and trying to get 1 value in the cell of other workbook, so is not a problem of memory or resources.
Thanks in advance.
I'd bet your Excel is not set to use R1C1 referencing, so the replace won't work as you're trying to put an R1C1 referenced string into an A1 style formula. Try using:
Application.ReferenceStyle = xlR1C1
With ActiveSheet.Range("F2")
.FormulaArray = theFormulaPart1
.Replace MiReemplazo, theFormulaPart2
End With
Application.ReferenceStyle = xlA1
This is a little time consuming due to forced recalculation of a moved object but it seems to work well.
Problem: external workbook references are pushing array formula over the character limit.
Solution: a) move the external worksheet to the local workbook b) complete the array formula insertion c) move the local worksheet back to the external workbook and let Excel figure it out.
Sub arrayFormulaTooBig()
Dim ha2ndx As Long, wbha As Workbook, wbf As Workbook
Dim sel As Range
Set sel = Selection
Set wbha = Workbooks("HOGARES ALBACETE.xlsx")
Set wbf = sel.parent.parent
'Application.Calculation = xlCalculationmanual
'Application.ScreenUpdating = False
'move the external worksheet to local and reduce worksheet name to minimum characters
With wbha
If .Worksheets.Count = 1 Then
.Worksheets.Add after:=.Worksheets(.Worksheets.Count)
.Worksheets(.Worksheets.Count).Name = "to be removed"
End If
With .Worksheets("21076")
ha2ndx = .Index
.Move after:=wbf.Worksheets(wbf.Worksheets.Count)
End With
End With
'minimize worksheet name
wbf.Worksheets("21076").Name = ChrW(215)
'from 282 characters
'Selection.FormulaArray = _
"=INDEX('[HOGARES ALBACETE.xlsx]21076'!C1,MATCH(MAX(IF(RIGHT('[HOGARES ALBACETE.xlsx]21076'!C1,LEN(R[-1]C)+2)=""["" &R[-1]C&""]"",'[HOGARES ALBACETE.xlsx]21076'!C2)),IF(RIGHT('[HOGARES ALBACETE.xlsx]21076'!C1,LEN(R[-1]C)+2)=""[""&R[-1]C&""]"",'[HOGARES ALBACETE.xlsx]21076'!C2),0),1)"
'to 137 characters
sel.FormulaArray = _
"=INDEX(×!C1,MATCH(MAX(IF(RIGHT(×!C1,LEN(R[-1]C)+2)=""["" &R[-1]C&""]"",×!C2)),IF(RIGHT(×!C1,LEN(R[-1]C)+2)=""[""&R[-1]C&""]"",×!C2),0),1)"
With wbf
With .Worksheets(ChrW(215))
.Move before:=wbha.Worksheets(ha2ndx)
End With
End With
'restore worksheet name
wbha.Worksheets(ChrW(215)).Name = "21076"
On Error Resume Next
Application.DisplayAlerts = False
wbha.Worksheets("to be removed").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I have a webquery within a macro.
.Refresh BackgroundQuery:=False
The above line puts the webpage contents in the active worksheet. Then I find a string "approved" with the code given below
Set findRng = Cells.Find(What:="approved", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If the string is found, I do some job with the code given below
If Not findRng Is Nothing Then
'do some job
End If
Can I find the word approved directly from memory or some kind of array without putting the contents of the webpage in the sheet and if yes, how?
Function GetResponseText(url as String) as String
Dim objHttp As Object
objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open("GET", url, False)
objHttp.Send("")
GetResponseText = objHttp.ResponseText
End Function
GetResponseText contains the html as text (full scripting)
search with:
If instr(GetResponseText([your url]), "approved") > 1 Then
'your code if approved
Else
'your code if not
End If
you may check the string of 'GetResponseText' and search for ">approved<" or something like that
I have several csv files in one folder. I want to add these files into one excel files with multiple worksheets.
Before I add them in my excel sheet I want to replace . with ,, because of my convention in excel.
However, the code below gives me:
Here is my code:
Option Explicit
Sub ImportCSVs()
'Summary: Import all CSV files from a folder into separate sheets
' named for the CSV filenames
Dim fPath As String
Dim fCSV As String
Dim fnd As Variant
Dim rplc As Variant
Dim wbCSV As Workbook
'add your find and replace values!
'#############################
fnd = "."
rplc = ","
Application.ScreenUpdating = False 'speed up macro
'path to CSV files, include the final \
'#############################
fPath = "C:\Users\Desktop\Data\23-3-2015_Data\"
fCSV = Dir(fPath & "*.csv") 'start the CSV file listing
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file and move
'find and replace the . by ,
For Each wbCSV In ActiveWorkbook.Worksheets
wbCSV.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next wbCSV
ActiveSheet.Move After:=ThisWorkbook.Sheets(Sheets.Count)
fCSV = Dir 'ready next CSV
Loop
Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
Any recommendation what I am doing wrong?
I appreciate your reply!
Try this:
'add to your Dim statements:
Dim ws as Worksheet
'change your Do loop to:
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file and move
'find and replace the . by ,
For Each ws In wbcsv
ws.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next ws
Also, I find it's easier to debug things if you leave the Application.ScreenUpdating = False commented out until everything's working. You're not all that worried about execution speed when you're debugging.
An alternative loop since you're opening a CSV, there can only be one worksheet in it, this should simplify things a bit:
Dim DestBook as workbook
Set DestBook = ThisWorkbook
'other setup stuff...
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file and move
'find and replace the . by ,
wbCSV.worksheet(1).Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
wbcsv.move after:=DestBook.sheets(DestBook.sheets.count)
wbCSV.close
vFCSV = Dir
Loop
I also noted that the move was moving it to ThisWorkbook and there's no guarantee what that would be when you got there. So, I declared a new WorkBook variable and assigned it to ThisWorkbook before doing anything, that way you're 100% certain where you're moving it to. I also closed the CSV that we opened, just for some tidying up.
In the error line For Each wbCSV In ActiveWorkbook.Worksheets you want to loop through all the worksheets but you are using wbCSV which is declared As Workbook.
To solve the type mismatch add a new variable Dim wsCSV As Worksheet and use this new variable in the loop as a reference for each worksheet.
The loop could look like this :
For Each wsCSV In wbCSV.Worksheets
wsCSV.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next wsCSV
wbCSV is workbook object not worksheet .
try this
Dim ws as Worksheet
for each ws in activeworkbook.worksheets
I don't know your method for going through wbCSV, never did it but doesn't seem right...
I cant suggest you use what I posted here just by switching "xml" to "csv" :
https://stackoverflow.com/questions/29184595/loop-on-all-files-in-the-same-directory-then-detect-extension-type/29187762#29187762
I think it'll be a rather good start for what you have to do! ;)
I searched for the answer to this question, and came VERY CLOSE with
VBA: need decide if result of FIND method is NOTHING or "" (empty)
but I couldn't quite understand how to fix my problem. It is pretty much the same, I am using find to look up something in another workbook, and if the find() can't find what I'm looking for, it throws an error. I tried the suggestions in the link above, but I agree with https://stackoverflow.com/users/478884/tim-williams that since my object is still empty, that the IIF() will error still.
Do Until Row > LastRow
On Error GoTo MFGPNError
PLRow = Workbooks(WB2).Sheets("5727").Range("C:C").Find(what:=Workbooks(WB1).Main.Cells(Row, 2).Value2, lookat:=xlWhole, searchorder:=xlByRows, MatchCase:=True).row
VREFLookup:
On Error GoTo VREFError
PLRow = Workbooks(WB2).Sheets("5727").Range("D:D").Find(what:=Workbooks(WB1).Main.Cells(Row, 2).Value2, lookat:=xlWhole, searchorder:=xlByRows, MatchCase:=True).row
Then my error trapping:
Exit Sub
MFGPNError:
If PLRow Is Empty Then
Workbooks(WB1).Main.Cells(Row, 3) = ""
'If IIf(PLRow Is Empty, "", PLRow) = "" Then
'setting MPN to be "" and moving to VREF lookup
On Error GoTo -1
GoTo VREFLookup
End If
'-----
Exit Sub
VREFError:
If IIf(PLRow Is Nothing, "", PLRow) = "" Then
'setting MPN to be "" and then adding cleaned up pn to array?
WB1.Main.Cells(Row, 3) = ""
On Error GoTo -1
GoTo CleanPN
End If
On my first Error Trap, I commented out the IIF() because it threw an error, and tried a regular IF(), still an error..
My question is, how can I keep going through my macro, if my Find() throws an error? I would like to just skip that particular Find(), and move on to the next row.
Also, is my error-handling any good? I've never really had to do much of it (mainly do to my macros being very simple)
I think this is your problem: the result of the .Find method is a range object, which can be Nothing. You are trying to evaluate Nothing.Row which raises an error.
Rather than deal with messy error handlers and confusing GoTo statements, it's best to simply trap that error and deal with it properly.
First, declare a range object and use that to return the result of the .Find.
Dim rngFound as Range
'## Attempt the lookup in Column C:
Set rngFound = Workbooks(WB2).Sheets("5727").Range("C:C").Find( _
what:=Workbooks(WB1).Main.Cells(Row, 2).Value2, _
lookat:=xlWhole, searchorder:=xlByRows, MatchCase:=True)
Then, you can deal with this rngFound variable, and test whether it's Nothing. If it is, then do another Find against column D:
'## If not found, look for it in column D:
If rngFound Is Nothing Then
Set rngFound = Workbooks(WB2).Sheets("5727").Range("D:D").Find( _
what:=Workbooks(WB1).Main.Cells(Row, 2).Value2, _
lookat:=xlWhole, searchorder:=xlByRows, MatchCase:=True)
End If
If the second find also fails, then you do something else which you already know how to do:
If rngFound Is Nothing Then
'## DO SOMETHING ELSE ##
End If
Then, you can assign to your PLRow variable
If rngFound Is Nothing then
PLRow = Empty '## Or modify as needed.
Else:
PLRow = rngFound.Row
End If
As a best practice, you should avoid using On Error GoTo... statements whenever possible, especially when the error can be suitably trapped without an error handler. Also, within your error handlers (if you absolutely must use them for some other reason), you should probably do Err.Clear and also Resume Next instead of GoTo VREFLookup.
I've got a folder of excel worksheets, and also another worksheet with a column whose entries correspond to the file names of the worksheets in the folder.
The column to the right of the worksheet names has a number, which I want to paste into each corresponding worksheet... but it's not working... here's my code so far :
Sub FraisRank()
Dim folderPath As String
Dim filename As String
Dim filenameshort As String
Dim wb As Workbook
Dim fraislist As Workbook
Dim find As Range
Dim sel As Range
folderPath = "C:\Users\richard\Desktop\temp"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
Set fraislist = Workbooks.Open("C:\Users\richard\desktop\frais list.xlsx")
filename = Dir(folderPath & "*.*")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)
filenameshort = Left(filename, Len(filename) - 4)
Set sel = fraislist.Sheets(1).Range("A1:A164")
Set find = sel.find(What:=filenameshort, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If find Is Nothing Then
MsgBox ("Cell " & filenameshort & " not found")
Else
find.Offset(, 1).Resize(1, 1).Copy
ActiveSheet.Range("$H$5").PasteSpecial Paste:=xlPasteValues
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
filename = Dir
Loop
End Sub
For the moment I'm getting a Runtime error '13', type mismatch on the 'Set find = ...' part. And in general I don't really understand how to run the '.find' on the selected cells in the 'fraislist' workbook...
The problem with ActiveCell is that it will always refer to the Activesheet and hence statements like Activecell/Select/Activate/ActiveSheet/Activeworkbook should be avoided. Always create relevant objects and work with them
INTERESTING READ
In your case it is not necessary that the ActiveSheet is fraislist.Sheets(1) so ActiveCell might not be referring to the correct sheet and hence, it's better to qualify it completely.
If you change After:=ActiveCell to After:=fraislist.Sheets(1).Range("A1") then your code will refer to the correct sheet and it will work.