In the code below LastCellR = 49 and LastSheet is 61 (i.e. there are 61 sheets in the workbook and 49 client names in column 1 of the active sheet)
The code runs fine till i gets to 46 and CS gets to 61. Then in Debug, the code stops and highlights
"If Worksheets(CS).Name = ClientName Then".
The goal here is to go down a list of client names and determine if they are existing clients or new ones. So I simply get each client's name and search through the sheet names in the workbook.
Any ideas why it stops dead in it's tracks?
Thanks for any insight you can provide.
For i = 2 To LastCellR
ClientName = Cells(i, 1).Value
If Trim(ClientName) = "" Then Exit Sub
' Check for existing client
For CS = 1 To LastSheet
If Worksheets(CS).Name = ClientName Then
NewClient = False
Exit For
End If
Next CS
Next i
Not the answer to your issues, may be another option to check for the sheet
Public Function WorksheetExists(strName As String) As Boolean
On Error GoTo eHandle
Dim ws As Excel.Worksheet
WorksheetExists = True
Set ws = ThisWorkbook.Worksheets(strName)
Set ws = Nothing
Exit Function
eHandle:
WorksheetExists = False
Resume Next
End Function
Then newclient = not worksheetexists(clientname)
Related
I wrote below script but get hung up on this part of the code:
If TargetWb.Sheets("Expenses").Range("F61").Offset(0, i - 1).Value = CVErr(xlErrNA) Then GoTo Skip Else GoTo Continue
What I'm trying to do: if the value of the cell returns #N/A as part of a function I would like to move to next loop. Any recommendation on how to accomplish this?
Thanks in advance for solutions. Also always open to recommendations on how to better structure this code, as I'm still a beginner.
Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim S_Deal As Range
Dim i As Integer
'SourceWb - Workbook were data is copied from
'TargetWb - Workbook were data is copied to and links are stored
Application.ScreenUpdating = False
Set TargetWb = ThisWorkbook
filePath = ThisWorkbook.Sheets("Expenses").Range("S4").Value
Set SourceWb = Workbooks.Open(filePath)
For i = 1 To 6
If TargetWb.Sheets("Expenses").Range("F61").Offset(0, i - 1).Value = CVErr(xlErrNA) Then GoTo Skip Else GoTo Continue
Continue:
Set S_Deal = TargetWb.Sheets("Expenses").Cells(11, 5 + i)
SourceWb.ActiveSheet.Range("OPEX_Control").Value = S_Deal.Value
TargetWb.Sheets("Expenses").Range("F12:F15").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("P9:P12").Value
TargetWb.Sheets("Expenses").Range("F18:F21").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o14:o17").Value
TargetWb.Sheets("Expenses").Range("F23:F26").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o19:o22").Value
TargetWb.Sheets("Expenses").Range("F29").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o25").Value
Skip:
Next i
Application.ScreenUpdating = True
End Sub
If you want to check whether the excel function return #N/A in vba, you can use the following code:
If Application.WorksheetFunction.IsNA(Cells(intRow, x)) Then
Since what you want is the execute a code unless the the wb.function is not #N/A, by re-arrange your If VBA code should be able to achieve your desired outcome.
If Application.WorksheetFunction.IsNA(TargetWb.Sheets("Expenses").Range("F61")) = false then
{your code}
end if
next i
So when the wb function return #N/A, it will not execute the code in between and go to next loop
I have a spreadsheet which allows users to enter information onto a single page then press a button to send all the info to where it needs to go. I have a function which checks to see if a sheet exists and then creates a copy of a template sheet and renames it to the required name.
Application.ScreenUpdating = False
For i = 1 To 10
OpName = Cells(i + 3, 2).Value
If Not OpName = "" Then
OpCheck (OpName)
So the code above cycles through the cells down row B and runs the opcheck function as described above.
Function OpCheck(Init As String)
Init = UCase(Init)
exists = False
For i = 1 To Worksheets.Count
If Worksheets(i).Name = Init Then
exists = True
End If
Next i
If Not exists Then
Sheets("Op Template").Visible = True
Sheets("Op Template").Activate
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = Init
RenameTable (Init)
On Error Resume Next
End If
Sheets("Op Template").Visible = False
End Function
This is the code for the function and the error occurs in the line
ActiveSheet.Name = Init
This has worked some of the time but is now failing to find a sheet with the name TS and gets an error when it tries to rename a new page with a name that already exists. I just don't understand why it isn't finding the page in the first place.
Thanks in advance.
The reason your code is sometimes failing to find is because you need to exit the For loop once the sheet is found. A fix is:
For i = 1 To Worksheets.Count
If Worksheets(i).Name = Init Then
exists = True
Exit For ' ADD THIS LINE
End If
Next i
A couple of other code comments:
Consider changing Function OpCheck to Sub OpCheck since you're not returning anything
Your code may be causing Init to be converted to upper case in the function or sub that calls OpCheck. To avoid this, change the declaration to: OpCheck(ByVal Init As String)
This section of code:
Sheets("Op Template").Visible = True
Sheets("Op Template").Activate
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = Init
RenameTable (Init)
can be made less risky by avoiding ActiveSheet
dim ws as Worksheet
Set ws = Sheets("Op Template")
ws.Visible = True
ws.Copy After:=Worksheets(Sheets.Count)
' Instead of this
' ActiveSheet.Name = Init
' Something like this
Worksheets(Sheets.Count).Name = Init
RenameTable (Init)
Hope that helps
The code is given below.
Run time error 91 object variable or with block variable not set.
It works perfectly sometime but sometime shows the given error.
Option Explict
Public wb As Workbook
Private rowMsg As Integer
Public Sub showMsg(pMsg As String, Optional pColorError As Boolean,
Optional pColorSuccessful As Boolean)
With wb.sheets("Setup")
.Rows(rowMsg).HorizontalAlignment = xlLeft
.Rows(rowMsg).VerticalAlignment = xlBottom
.Rows(rowMsg).WrapText = True
.Rows(rowMsg).Orientation = 0
.Rows(rowMsg).AddIndent = False
.Rows(rowMsg).IndentLevel = 0
.Rows(rowMsg).ShrinkToFit = False
.Rows(rowMsg).ReadingOrder = xlContext
.Rows(rowMsg).MergeCells = True
.Cells(rowMsg, 1).Value = Now & Space(3) & pMsg
If pColorSuccessful Then
.Cells(rowMsg, 1).Interior.ColorIndex = 43
End If
If pColorError Then
.Cells(rowMsg, 1).Interior.ColorIndex = 3
End If
End With
rowMsg = rowMsg + 1
End Sub
The issue is probably that you did not initialize your global variables:
Public wb As Workbook
Private rowMsg As Long '<-- needs to be long not integer.
If you then run showMsg for the first time wb is Nothing and rowMsg is 0 (which is not a valid row number, as it starts with row = 1).
So test if your variables were initialized before you run any code on them.
Public Sub showMsg(pMsg As String, Optional pColorError As Boolean, Optional pColorSuccessful As Boolean)
'test if global variables were initialized, if not do it.
If wb Is Nothing Then
Set wb = ThisWorkbook
End If
If rowMsg = 0 Then rowMsg = 1
'your code here …
End Sub
There are only three objects in the program you list: wb, The worksheet named "Setup" and the cell defined by Rowmsg. In order to get the error in this listing one of these three doesn't exist. Either there is no sheet called "Setup", the workbook object pointed to by wb does not exist or (and this is most like) the variable RowMsg holds an invalid value for the use you are making of it. At a guess you are using Find to set the row number and the error occurs when it doesn't find a result.
When you get the error choose debug and examine the line that is reporting the error. You can then use "View, Call Stack" in the vb editor to step back through your program to see what failed to set the variable correctly
I'm trying to determine if a named range has been set via VBA. The named range is called LoadedToken and essentially is loaded when a user clicks a particular button. I use this as proof that initialisation has taken place.
I have a function to check if this has taken place:
Function ToolIsEnabled()
' We check if the R2A add-in has been loaded by detecting the named range
If ActiveWorkbook.Names("LoadedToken") Is Nothing Then
ToolIsEnabled = False
Else
ToolIsEnabled = True
End If
End Function
and I get an application error. Of course, the VBA is incorrect. However how can I actually accomplish this?!
Sub Test()
Debug.Print IsNamedRange("Bumsti")
End Sub
Function IsNamedRange(RName As String) As Boolean
Dim N As Name
IsNamedRange = False
For Each N In ActiveWorkbook.Names
If N.Name = RName Then
IsNamedRange = True
Exit For
End If
Next
End Function
Usage in OP context could be
' ...
If IsNamedRange("LoadedToken") Then
' ...
End If
' ...
or - if a program specific Bool needs to be set
' ...
Dim IsTokenLoaded as Boolean
IsTokenLoaded = IsNamedRange("LoadedToken")
' ...
Both constructs make it pretty clear in the source code what you are aiming for.
You can achieve this by using error handling:
Function ToolIsEnabled() As Boolean
Dim rng As Range
On Error Resume Next
Set rng = ActiveWorkbook.Range("LoadedToken")
On Error GoTo 0
ToolIsEnabled = Not rng is Nothing
End Function
This will check either in ThisWorkbook or a named workbook and return TRUE/FALSE.
Sub Test()
MsgBox NamedRangeExists("SomeName")
MsgBox NamedRangeExists("SomeOtherName", Workbooks("Book1.xls"))
End Sub
Public Function NamedRangeExists(sName As String, Optional Book As Workbook) As Boolean
On Error Resume Next
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Edit:
A shorter version if it's only going to look in ThisWorkbook:
Public Function NamedRangeExists(sName As String) As Boolean
On Error Resume Next
NamedRangeExists = ThisWorkbook.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
For the activeworkbook, you could also call the old XLM NAMES() function:
Function IsNameInActiveWorkbook(sName As String) As Boolean
IsNameInActiveWorkbook = Not IsError(Application.ExecuteExcel4Macro("MATCH(""" & sName & """,NAMES(),0)"))
End Function
As per Tom's answer these 2 line should do the trick:
On Error Resume Next
Set TestRange = ActiveWorkbook.Range("LoadedToken") 'if it does **not** exist this line will be ERROR
Can anyone tell me how to improve this macro?
All the macro does is it just reads an Excel file for a list a accounts to update in an application (SmarTerm Beta). It technically already accomplishes the goal, but is there a way to code it so that while it’s reading the Excel file, the coordinates of the cells from which to read the account numbers and also the coordinates of the cells in which to write an output don’t depend on a "pre-selected" a cell? The risk with selecting a cell is that if someone were to accidentally select a different cell while the macro is running, everything will get screwed up.
Here's my current code:
Public oExcelObj As Object
Function WaitSystem(Optional NoDialog as Variant) As Boolean
Dim nContinue as Integer
Dim nTimeOut as Integer 'In seconds.
'The default timeout for each command is 3 minutes.
'Increase this value if your host requires more time
'for each command.
nTimeOut = 10
If IsMissing(NoDialog) then NoDialog = False
'Wait for response from host.
Session.EventWait.Timeout = nTimeOut
Session.EventWait.EventType = smlPAGERECEIVED
Session.EventWait.MaxEventCount = 1
WaitSystem = True
If Session.EventWait.Start = smlWAITTIMEOUT Then
If NoDialog Then
WaitSystem = False
Else
nContinue = QuerySyncError()
If nContinue <> ebYes then WaitSystem = False
End If
End If
Set LockStep = Nothing
End Function
'Establish link. Search for Excel.
Function OleLinkConnection
Const XlMaximized = &HFFFFEFD7
Titlebar$ = AppFind$("Microsoft Excel")
If Titlebar$ <> "" Then
bIsExcelActive = True
If AppGetState(Titlebar$) = ebMinimized Then
AppSetState 2, Titlebar$
End If
Else
bIsExcelActive = False
End If
If bIsExcelActive Then
'Create Excel Object using current instance of Excel.
Set oExcelObj = GetObject(, "Excel.Application")
Else
'Create Excel Object using a new instance of Excel.
Set oExcelObj = CreateObject("Excel.Application")
End If
Version = oExcelObj.Application.Version
oExcelObj.ScreenUpdating = True
oExcelObj.Displayalerts = True
oExcelObj.Visible = true
End Function
Sub JPBmacro
Dim AccountNumber As String
Dim Temp As Integer
Begin Dialog StartDialogTemplate ,,211,74,"Run JPBmacro?"
OKButton 60,12,92,20,.Proceed
CancelButton 60,40,92,20,.Exit
End Dialog
Dim StartDialog As StartDialogTemplate
r% = Dialog(StartDialog)
If r% = 0 Then End
g$ = "G:\DATA\outputfile.xlsx"
oleCode = OleLinkConnection
oExcelObj.Workbooks.Open g$
oExcelObj.Range("A1").Select ‘<----This selects the cell from which all coordinates are based off of. The coordinates of oExcelObj.ActiveCell.Offset(Y,X).Value VBA depend on selecting a cell.
NEXTACCOUNT:
Temp = 0
AccountNumber = oExcelObj.ActiveCell.Offset(Temp,0).Value
While AccountNumber <> ""
Session.SendKey "CLEAR"
If WaitSystem = False Then End
Session.Send "ACTU " & AccountNumber
Session.SendKey "ENTER"
If WaitSystem = False Then End
If Trim(Session.ScreenText(4,6,1,22)) = "INVALID ACCOUNT NUMBER" Or Trim(Session.ScreenText(4,6,1,19)) = "ACCOUNT NOT ON FILE" Then
oExcelObj.ActiveCell.Offset(Temp,1).Value = Trim(Session.ScreenText(4,6,1,22))
GoTo RESTARTLOOP
End If
UPDATEIOV:
If Trim(Session.ScreenText(13,76,1,1)) = "Y" Then
oExcelObj.ActiveCell.Offset(Temp,1).Value = "Account already flagged as institutional."
Else
Session.Row = 13
Session.Column = 76
Session.send "Y"
Session.SendKey "ENTER"
If WaitSystem = False Then End
oExcelObj.ActiveCell.Offset(Temp,1).Value = Trim(Session.ScreenText(24,2,1,50))
End If
RESTARTLOOP:
Temp = Temp + 1
AccountNumber = oExcelObj.ActiveCell.Offset(Temp,0).Value
Wend
ENDNOW:
oExcelObj.Workbooks.Close
MsgBox "All Done!"
End Sub
Why not keep the reference to the first cell?
Dim rng as Range
Set rng = oExcelObj.Range("A1")
i=1
...
x = rng.Cell(i,1).Value
'Or faster yet is reading all the values into an variant array.
Dim array() as Variant
array = rng.Resize(N,M).Value
' Work with array as
x = array(i,1)
Given the comment from assylias and that another poster has since "answered" with this approach:
I can't see where oExcelObj is instantiated? Or how you are referring to a specific sheet.
Regardless of which,
you can avoid select by setting a range, ie Set rng1 = oExcelObj.Sheets(1).Range("A1")
and then use offsets from rng1.
The user won't be able to interfere while the code is running