Getting a range from the user with VBA (Bug in Application.InputBox function)
Content
- Applies to
- Introduction
- How to reproduce the bug
- Method 1: use a userform.
- Method 2: Use Application.InputBox anyway
Applies to
This bug applies to all excel versions as from Excel 5/95. It has been fixed in Excel 2007.
Introduction
This article describes a bug discovered by Ron de Bruin.
The Application.InputBox function is very useful to get a range from the user. Unfortunately, this function exposes a bug in Excel (all current versions up to and including 2003!). If the sheet on which a (range of) cell(s) is selected contains conditional formatting using the : "Formula Is" option, the function may fail, returning an empty range.
How to reproduce the bug
Use this sample code on a worksheet with elaborate conditional formatting (see download below for an example):
Option Explicit
Sub ProblemCode()
Dim oRangeSelected As Range
On Error Resume Next
Set oRangeSelected = Application.InputBox("Please select a range of cells!", _
"SelectARAnge Demo", Selection.Address, , , , , 8)
If oRangeSelected Is Nothing Then
MsgBox "It appears as if you pressed cancel!"
Else
MsgBox "You selected: " & oRangeSelected.Address(External:=True)
End If
End Sub
Sub ProblemCode()
Dim oRangeSelected As Range
On Error Resume Next
Set oRangeSelected = Application.InputBox("Please select a range of cells!", _
"SelectARAnge Demo", Selection.Address, , , , , 8)
If oRangeSelected Is Nothing Then
MsgBox "It appears as if you pressed cancel!"
Else
MsgBox "You selected: " & oRangeSelected.Address(External:=True)
End If
End Sub
If you run this code and the user selects a range on a worksheet with conditional formatting which uses a "Formula Is" setting, the code may return an empty range object, even if the user selected a valid area and hit OK. An example formula for the CF might be:
=OR($AL1=1, $AL1=3)
There are two possible workarounds.
Method 1: use a userform.
I included a userform with two controls: A dropdown to select the workbook and a refedit control to select ranges. Note that the refedit control has been causing some havoc with some users, due to updates to Office versions. A foolproof way to overcome trouble which users might have with your file is opening the file in Excel 2000 and saving it again, before distributing.
The userform looks like this:
Selecting a range using the userform
The code that shows the form:
'-------------------------------------------------------------------------
' Module : modWorkaround1
' Company : JKP Application Development Services (c)
' Author : Jan Karel Pieterse (jkp-ads.com)
' Created : 23-2-2009
' Purpose : Workaround for the application.inputbox (type 8) bug
'-------------------------------------------------------------------------
Option Explicit
Sub Test()
Dim oRangeSelected As Range
If SelectARange("Please select a range of cells!", "SelectARAnge Demo", oRangeSelected) = True Then
MsgBox "You selected:" & oRangeSelected.Address(, , , True)
Else
MsgBox "You cancelled"
End If
End Sub
Function SelectARange(sPrompt As String, sCaption As String, oReturnedRange As Range) As Boolean
Dim frmSelectCells As ufSelectCells
Set frmSelectCells = New ufSelectCells
With frmSelectCells
.PromptText = sPrompt
.CaptionText = sCaption
If TypeName(Selection) = "Range" Then
.StartAddress = Selection.Address(External:=True)
End If
.Initialise
.Show
If .OK Then
Set oReturnedRange = .ReturnedRange
If oReturnedRange Is Nothing Then
SelectARange = False
Else
SelectARange = True
End If
Else
SelectARange = False
End If
End With
Unload frmSelectCells
Set frmSelectCells = Nothing
End Function
' Module : modWorkaround1
' Company : JKP Application Development Services (c)
' Author : Jan Karel Pieterse (jkp-ads.com)
' Created : 23-2-2009
' Purpose : Workaround for the application.inputbox (type 8) bug
'-------------------------------------------------------------------------
Option Explicit
Sub Test()
Dim oRangeSelected As Range
If SelectARange("Please select a range of cells!", "SelectARAnge Demo", oRangeSelected) = True Then
MsgBox "You selected:" & oRangeSelected.Address(, , , True)
Else
MsgBox "You cancelled"
End If
End Sub
Function SelectARange(sPrompt As String, sCaption As String, oReturnedRange As Range) As Boolean
Dim frmSelectCells As ufSelectCells
Set frmSelectCells = New ufSelectCells
With frmSelectCells
.PromptText = sPrompt
.CaptionText = sCaption
If TypeName(Selection) = "Range" Then
.StartAddress = Selection.Address(External:=True)
End If
.Initialise
.Show
If .OK Then
Set oReturnedRange = .ReturnedRange
If oReturnedRange Is Nothing Then
SelectARange = False
Else
SelectARange = True
End If
Else
SelectARange = False
End If
End With
Unload frmSelectCells
Set frmSelectCells = Nothing
End Function
The code behind the form:
Option Explicit
Private mbOK As Boolean
Private moReturnedRange As Range
Private msPromptText As String
Private msCaptionText As String
Private msStartAddress As String
Public Sub Initialise()
Dim oBk As Workbook
cmbOK.Enabled = False
lblQuestion.Caption = msPromptText
Me.Caption = CaptionText
refSelectCells.Text = StartAddress
cbxWorkbooks.Clear
For Each oBk In Workbooks
If oBk.Windows(1).Visible Then
cbxWorkbooks.AddItem oBk.Name
End If
Next
cbxWorkbooks.Value = ActiveWorkbook.Name
End Sub
Private Sub cbxWorkbooks_Change()
Windows(cbxWorkbooks.Value).Activate
End Sub
Private Sub cmbCancel_Click()
OK = False
Me.Hide
End Sub
Private Sub cmbOK_Click()
If refSelectCells.Text <> "" Then
If TypeName(Selection) = "Range" Then
If IsValidRef(refSelectCells.Text) Then
OK = True
End If
End If
End If
Me.Hide
End Sub
Public Property Get OK() As Boolean
OK = mbOK
End Property
Public Property Let OK(ByVal bOK As Boolean)
mbOK = bOK
End Property
Public Property Get ReturnedRange() As Range
Dim sRef As String
Dim oSh As Worksheet
On Error Resume Next
sRef = refSelectCells.Text
If OK And IsValidRef(sRef) Then
If InStr(sRef, "!") Then
Set oSh = ActiveWorkbook.Worksheets(Application.Substitute(Left(sRef, InStr(sRef, "!") - 1), "'", ""))
Else
Set oSh = ActiveSheet
End If
Set moReturnedRange = oSh.Range(Mid(sRef, InStr(sRef, "!") + 1))
Set ReturnedRange = moReturnedRange
End If
End Property
Public Property Set ReturnedRange(oReturnedRange As Range)
Set moReturnedRange = oReturnedRange
End Property
Public Function IsValidRef(sRef As String) As Boolean
'-------------------------------------------------------------------------
' Procedure : IsValidRef Created by Jan Karel Pieterse
' Company : JKP Application Development Services (c) 2005
' Author : Jan Karel Pieterse
' Created : 21-12-2005
' Purpose : Checks of argument is a valid cell reference
'-------------------------------------------------------------------------
Dim sTemp As String
Dim oSh As Worksheet
Dim oCell As Range
' On Error GoTo LocErr
IsValidRef = False
On Error Resume Next
sTemp = Left(sRef, InStr(sRef, "!") - 1)
sTemp = Replace(sTemp, "=", "")
If Not IsIn(ActiveWorkbook.Worksheets, sTemp) Then
IsValidRef = False
Exit Function
End If
Set oSh = ActiveWorkbook.Worksheets(sTemp)
If oSh Is Nothing Then
Set oSh = ActiveWorkbook.Worksheets(Replace(sTemp, "'", ""))
End If
sTemp = Right(sRef, Len(sRef) - InStr(sRef, "!"))
Set oCell = oSh.Range(sTemp)
If oCell Is Nothing Then
IsValidRef = False
Else
IsValidRef = True
End If
End Function
Function IsIn(vCollection As Variant, ByVal sName As String) As Boolean
'-------------------------------------------------------------------------
' Procedure : funIsIn Created by Jan Karel Pieterse
' Company : JKP Application Development Services (c) 2005
' Author : Jan Karel Pieterse
' Created : 28-12-2005
' Purpose : Determines if object is in collection
'-------------------------------------------------------------------------
Dim oObj As Object
On Error Resume Next
Set oObj = vCollection(sName)
If oObj Is Nothing Then
IsIn = False
Else
IsIn = True
End If
If IsIn = False Then
sName = Replace(sName, "'", "")
Set oObj = vCollection(sName)
If oObj Is Nothing Then
IsIn = False
Else
IsIn = True
End If
End If
End Function
Public Property Let PromptText(ByVal sPromptText As String)
msPromptText = sPromptText
End Property
Private Sub refSelectCells_Change()
If IsValidRef(refSelectCells.Text) Then
cmbOK.Enabled = True
Else
cmbOK.Enabled = False
End If
End Sub
Public Property Get CaptionText() As String
CaptionText = msCaptionText
End Property
Public Property Let CaptionText(ByVal sCaptionText As String)
msCaptionText = sCaptionText
End Property
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> vbFormCode Then
Cancel = True
Me.cmbCancel.SetFocus
cmbCancel_Click
End If
End Sub
Public Property Get StartAddress() As String
msStartAddress = Mid(msStartAddress, InStr(msStartAddress, "]") + 1)
StartAddress = msStartAddress
End Property
Public Property Let StartAddress(sStartAddress As String)
msStartAddress = sStartAddress
End Property
Private mbOK As Boolean
Private moReturnedRange As Range
Private msPromptText As String
Private msCaptionText As String
Private msStartAddress As String
Public Sub Initialise()
Dim oBk As Workbook
cmbOK.Enabled = False
lblQuestion.Caption = msPromptText
Me.Caption = CaptionText
refSelectCells.Text = StartAddress
cbxWorkbooks.Clear
For Each oBk In Workbooks
If oBk.Windows(1).Visible Then
cbxWorkbooks.AddItem oBk.Name
End If
Next
cbxWorkbooks.Value = ActiveWorkbook.Name
End Sub
Private Sub cbxWorkbooks_Change()
Windows(cbxWorkbooks.Value).Activate
End Sub
Private Sub cmbCancel_Click()
OK = False
Me.Hide
End Sub
Private Sub cmbOK_Click()
If refSelectCells.Text <> "" Then
If TypeName(Selection) = "Range" Then
If IsValidRef(refSelectCells.Text) Then
OK = True
End If
End If
End If
Me.Hide
End Sub
Public Property Get OK() As Boolean
OK = mbOK
End Property
Public Property Let OK(ByVal bOK As Boolean)
mbOK = bOK
End Property
Public Property Get ReturnedRange() As Range
Dim sRef As String
Dim oSh As Worksheet
On Error Resume Next
sRef = refSelectCells.Text
If OK And IsValidRef(sRef) Then
If InStr(sRef, "!") Then
Set oSh = ActiveWorkbook.Worksheets(Application.Substitute(Left(sRef, InStr(sRef, "!") - 1), "'", ""))
Else
Set oSh = ActiveSheet
End If
Set moReturnedRange = oSh.Range(Mid(sRef, InStr(sRef, "!") + 1))
Set ReturnedRange = moReturnedRange
End If
End Property
Public Property Set ReturnedRange(oReturnedRange As Range)
Set moReturnedRange = oReturnedRange
End Property
Public Function IsValidRef(sRef As String) As Boolean
'-------------------------------------------------------------------------
' Procedure : IsValidRef Created by Jan Karel Pieterse
' Company : JKP Application Development Services (c) 2005
' Author : Jan Karel Pieterse
' Created : 21-12-2005
' Purpose : Checks of argument is a valid cell reference
'-------------------------------------------------------------------------
Dim sTemp As String
Dim oSh As Worksheet
Dim oCell As Range
' On Error GoTo LocErr
IsValidRef = False
On Error Resume Next
sTemp = Left(sRef, InStr(sRef, "!") - 1)
sTemp = Replace(sTemp, "=", "")
If Not IsIn(ActiveWorkbook.Worksheets, sTemp) Then
IsValidRef = False
Exit Function
End If
Set oSh = ActiveWorkbook.Worksheets(sTemp)
If oSh Is Nothing Then
Set oSh = ActiveWorkbook.Worksheets(Replace(sTemp, "'", ""))
End If
sTemp = Right(sRef, Len(sRef) - InStr(sRef, "!"))
Set oCell = oSh.Range(sTemp)
If oCell Is Nothing Then
IsValidRef = False
Else
IsValidRef = True
End If
End Function
Function IsIn(vCollection As Variant, ByVal sName As String) As Boolean
'-------------------------------------------------------------------------
' Procedure : funIsIn Created by Jan Karel Pieterse
' Company : JKP Application Development Services (c) 2005
' Author : Jan Karel Pieterse
' Created : 28-12-2005
' Purpose : Determines if object is in collection
'-------------------------------------------------------------------------
Dim oObj As Object
On Error Resume Next
Set oObj = vCollection(sName)
If oObj Is Nothing Then
IsIn = False
Else
IsIn = True
End If
If IsIn = False Then
sName = Replace(sName, "'", "")
Set oObj = vCollection(sName)
If oObj Is Nothing Then
IsIn = False
Else
IsIn = True
End If
End If
End Function
Public Property Let PromptText(ByVal sPromptText As String)
msPromptText = sPromptText
End Property
Private Sub refSelectCells_Change()
If IsValidRef(refSelectCells.Text) Then
cmbOK.Enabled = True
Else
cmbOK.Enabled = False
End If
End Sub
Public Property Get CaptionText() As String
CaptionText = msCaptionText
End Property
Public Property Let CaptionText(ByVal sCaptionText As String)
msCaptionText = sCaptionText
End Property
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> vbFormCode Then
Cancel = True
Me.cmbCancel.SetFocus
cmbCancel_Click
End If
End Sub
Public Property Get StartAddress() As String
msStartAddress = Mid(msStartAddress, InStr(msStartAddress, "]") + 1)
StartAddress = msStartAddress
End Property
Public Property Let StartAddress(sStartAddress As String)
msStartAddress = sStartAddress
End Property
Method 2: Use Application.InputBox anyway
The second method was suggested by Peter Thornton (also an Excel MVP).
It does use the Application.InputBox method, but uses type 0 instead of 8 and a helper function to extract a proper range from the entered string. Funny thing is, even though one uses type 0, the box still enables you to select cells.
The returned formula normally requires a little parsing before it will be recognized as a valid Range address. Therefore it makes sense to wrap all this in a function. This demo wrapper has two bonus features. Firstly, the developer has the option to re-activate the Input range. Secondly, if the user types an address instead of selecting cells, the user can make a couple of incorrect typo attempts without having to start all over, it happens!
The code to accomplish this is copied below:
Option Explicit
'Courtesy Peter Thornton (Excel MVP)
Sub TestGetInput()
Dim bGotRng As Boolean
Dim bActivate As Boolean
Dim rInput As Range
bActivate = False ' True to re-activate the input range
bGotRng = GetInputRange(rInput, "Please select a range of cells!", _
"SelectARAnge Demo", "", bActivate)
If bGotRng Then
MsgBox rInput.Address(External:=True)
Else
MsgBox "You pressed cancel"
End If
End Sub
Function GetInputRange(rInput As Excel.Range, _
sPrompt As String, _
sTitle As String, _
Optional ByVal sDefault As String, _
Optional ByVal bActivate As Boolean, _
Optional X, Optional Y) As Boolean
' rInput: The Input Range which returns to the caller procedure
' bActivate: If True user's input range will be re-activated
'
' The other arguments are standard InputBox arguments.
' sPrompt & sTitle should be supplied from the caller proccedure
' but sDefault will be completed below if empty
'
' GetInputRange returns True if rInput is successfully assigned to a Range
Dim bGotRng As Boolean
Dim bEvents As Boolean
Dim nAttempt As Long
Dim sAddr As String
Dim vReturn
On Error Resume Next
If Len(sDefault) = 0 Then
If TypeName(Application.Selection) = "Range" Then
sDefault = "=" & Application.Selection.Address
' InputBox cannot handle address/formulas over 255
If Len(sDefault) > 240 Then
sDefault = "=" & Application.ActiveCell.Address
End If
ElseIf TypeName(Application.ActiveSheet) = "Chart" Then
sDefault = " first select a Worksheet"
Else
sDefault = " Select Cell(s) or type address"
End If
End If
Set rInput = Nothing ' start with a clean slate
For nAttempt = 1 To 3 ' give user 3 attempts for typos
vReturn = False
vReturn = Application.InputBox(sPrompt, sTitle, sDefault, X, Y, Type:=0)
If False = vReturn Or Len(vReturn) = 0 Then
Exit For ' user cancelled
Else
sAddr = vReturn
' The address (or formula) could be in A1 or R1C1 style,
' w/out an "=" and w/out embracing quotes, depends if the user
' selected cells, typed an address, or accepted the default
If Left$(sAddr, 1) = "=" Then sAddr = Mid$(sAddr, 2, 256)
If Left$(sAddr, 1) = Chr(34) Then sAddr = Mid$(sAddr, 2, 255)
If Right$(sAddr, 1) = Chr(34) Then sAddr = Left$(sAddr, Len(sAddr) - 1)
' will fail if R1C1 address
Set rInput = Application.Range(sAddr)
If rInput Is Nothing Then
sAddr = Application.ConvertFormula(sAddr, xlR1C1, xlA1)
Set rInput = Application.Range(sAddr)
bGotRng = Not rInput Is Nothing
Else
bGotRng = True
End If
End If
If bGotRng Then
If bActivate Then ' optionally re-activate the Input range
On Error GoTo errH
bEvents = Application.EnableEvents
Application.EnableEvents = False
If Not Application.ActiveWorkbook Is rInput.Parent.Parent Then
rInput.Parent.Parent.Activate ' Workbook
End If
If Not Application.ActiveSheet Is rInput.Parent Then
rInput.Parent.Activate ' Worksheet
End If
rInput.Select ' Range
End If
Exit For
ElseIf nAttempt < 3 Then
' Failed to get a valid range, maybe a typo
If MsgBox("Invalid reference, do you want to try again ?", _
vbOKCancel, sTitle) <> vbOK Then
Exit For
End If
End If
Next ' nAttempt
cleanUp:
On Error Resume Next
If bEvents Then
Application.EnableEvents = True
End If
GetInputRange = bGotRng
Exit Function
errH:
Set rInput = Nothing
bGotRng = False
Resume cleanUp
End Function
'Courtesy Peter Thornton (Excel MVP)
Sub TestGetInput()
Dim bGotRng As Boolean
Dim bActivate As Boolean
Dim rInput As Range
bActivate = False ' True to re-activate the input range
bGotRng = GetInputRange(rInput, "Please select a range of cells!", _
"SelectARAnge Demo", "", bActivate)
If bGotRng Then
MsgBox rInput.Address(External:=True)
Else
MsgBox "You pressed cancel"
End If
End Sub
Function GetInputRange(rInput As Excel.Range, _
sPrompt As String, _
sTitle As String, _
Optional ByVal sDefault As String, _
Optional ByVal bActivate As Boolean, _
Optional X, Optional Y) As Boolean
' rInput: The Input Range which returns to the caller procedure
' bActivate: If True user's input range will be re-activated
'
' The other arguments are standard InputBox arguments.
' sPrompt & sTitle should be supplied from the caller proccedure
' but sDefault will be completed below if empty
'
' GetInputRange returns True if rInput is successfully assigned to a Range
Dim bGotRng As Boolean
Dim bEvents As Boolean
Dim nAttempt As Long
Dim sAddr As String
Dim vReturn
On Error Resume Next
If Len(sDefault) = 0 Then
If TypeName(Application.Selection) = "Range" Then
sDefault = "=" & Application.Selection.Address
' InputBox cannot handle address/formulas over 255
If Len(sDefault) > 240 Then
sDefault = "=" & Application.ActiveCell.Address
End If
ElseIf TypeName(Application.ActiveSheet) = "Chart" Then
sDefault = " first select a Worksheet"
Else
sDefault = " Select Cell(s) or type address"
End If
End If
Set rInput = Nothing ' start with a clean slate
For nAttempt = 1 To 3 ' give user 3 attempts for typos
vReturn = False
vReturn = Application.InputBox(sPrompt, sTitle, sDefault, X, Y, Type:=0)
If False = vReturn Or Len(vReturn) = 0 Then
Exit For ' user cancelled
Else
sAddr = vReturn
' The address (or formula) could be in A1 or R1C1 style,
' w/out an "=" and w/out embracing quotes, depends if the user
' selected cells, typed an address, or accepted the default
If Left$(sAddr, 1) = "=" Then sAddr = Mid$(sAddr, 2, 256)
If Left$(sAddr, 1) = Chr(34) Then sAddr = Mid$(sAddr, 2, 255)
If Right$(sAddr, 1) = Chr(34) Then sAddr = Left$(sAddr, Len(sAddr) - 1)
' will fail if R1C1 address
Set rInput = Application.Range(sAddr)
If rInput Is Nothing Then
sAddr = Application.ConvertFormula(sAddr, xlR1C1, xlA1)
Set rInput = Application.Range(sAddr)
bGotRng = Not rInput Is Nothing
Else
bGotRng = True
End If
End If
If bGotRng Then
If bActivate Then ' optionally re-activate the Input range
On Error GoTo errH
bEvents = Application.EnableEvents
Application.EnableEvents = False
If Not Application.ActiveWorkbook Is rInput.Parent.Parent Then
rInput.Parent.Parent.Activate ' Workbook
End If
If Not Application.ActiveSheet Is rInput.Parent Then
rInput.Parent.Activate ' Worksheet
End If
rInput.Select ' Range
End If
Exit For
ElseIf nAttempt < 3 Then
' Failed to get a valid range, maybe a typo
If MsgBox("Invalid reference, do you want to try again ?", _
vbOKCancel, sTitle) <> vbOK Then
Exit For
End If
End If
Next ' nAttempt
cleanUp:
On Error Resume Next
If bEvents Then
Application.EnableEvents = True
End If
GetInputRange = bGotRng
Exit Function
errH:
Set rInput = Nothing
bGotRng = False
Resume cleanUp
End Function
Comments
All comments about this page:
Comment by: Alex (13-7-2006 05:57:10) deeplink to this comment
I imported your code to try it with my current project which requires a selection of cells via user input. Your program ran correctly, but the end result still left my range variable empty.
Comment by: Hannah Li (28-7-2006 09:23:39) deeplink to this comment
Found not all conditional formatting. If simply AL1=1, it's ok.
Comment by: Colin D (9-1-2007 16:50:14) deeplink to this comment
Halleuja!!! You've solved a mystery I came across in an application I developed 12 months ago with exactly that situation (ie. heavy conditional formatting and an Inputbox seeking a range from the user). I was stumped as to why it wouldn't work and I couldn't get an answer from several Excel forums - so ended up abandoning the Inputbox.
Comment by: Jan Karel Pieterse (10-1-2007 02:26:53) deeplink to this comment
Hi Colin,
Glad I could help!
Comment by: Nick (11-5-2007 04:18:34) deeplink to this comment
Range("AL1").Select
ActiveCell.Value = "Sum"
Range("AL2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+RC[-2]"
Range("AL2").Select
Selection.AutoFill Destination:=Cells(65536, AL2).End(xlUp)
Range("AL2:AL159").Select
Columns("AL:AL").EntireColumn.AutoFit
Range("AL1").Select
what's wrong with this?
Comment by: Jan Karel Pieterse (11-5-2007 08:42:29) deeplink to this comment
Hi Nick,
It can be replaced with this:
Range("AL1").Value = "Sum"
Range(Range("AL2"),Range("AL65536").End(xlUp)).FormulaR1C1 = "=RC[-1]+RC[-2]"
Columns("AL:AL").EntireColumn.AutoFit
Range("AL1").Select
Comment by: Bill Szabo (28-6-2007 09:07:22) deeplink to this comment
THANKS!!! I have been fighting this bug for half a day
Comment by: Hassan (31-8-2007 00:46:25) deeplink to this comment
Hi all
I want to make Macro to copy particular range from different sheets and paste it on the one sheet the clear the content of particular range.
Please help me!
Thanks all
Comment by: Jan Karel Pieterse (31-8-2007 03:04:27) deeplink to this comment
Hi Hassan,
Like this:
WorkSheets("Sheet1").Range("A1:B10").Copy Destination := _
WorkSheets("Sheet2").Range("C1")
Comment by: Hassan (31-8-2007 15:03:09) deeplink to this comment
Hi Jan Karel
Thank you for your comment, but what about clearing the content of the particular ranges, by the way it is union range.
Once more thank you very much for your help.
Hassan
Comment by: Jan Karel Pieterse (1-9-2007 10:39:30) deeplink to this comment
Hi Hassan,
Range("A1").ClearContents
BTW: recording a macro while you do something is a good way to find out what method is used and what arguments are needed.
Comment by: Rich (4-10-2007 11:41:03) deeplink to this comment
I have a worksheet with data that I'm filtering with autofilter. How can I have the sheet automatically update my formulas (average, mode, median, stdDev, frequency) ranges? They are at the bottom of the worksheet. I would have used subTotal, but it does not allow for mode and median, frequency.
Comment by: Jan Karel Pieterse (4-10-2007 21:22:25) deeplink to this comment
Hi Rich,
May I advise you to ask this question in one of the newsgroups or fora I link to on my links page?
Comment by: Lennon (16-11-2007 08:08:59) deeplink to this comment
Hi - I'm trying to modify this VBA code to delete duplicates from range H and L. Currently it only deletes duplicates from H. Thanks
Option Explicit
Sub DeleteDups()
Dim x As Long
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
End Sub
Comment by: Jan Karel Pieterse (16-11-2007 08:12:08) deeplink to this comment
Hi Lennon,
What should it do, should it count a duplicate when both columns are duplicate, or when either of them contains a duplicate?
Comment by: Mahmoud (3-12-2007 12:36:31) deeplink to this comment
Hi all
help in this issue will be appreciated..
*Select a range of cells according to a criteria..
Thanks
Mahmoud
Comment by: Jan Karel Pieterse (4-12-2007 02:08:09) deeplink to this comment
Hi Mahmoud,
What criteria do you have in mind?
Comment by: Mahmoud (4-12-2007 12:17:29) deeplink to this comment
Hi Jan
Data Renewal Automatically every day and i have made an archive for this data by a code....The Request if i take this data once to the archive>>.>.>>>>>....don't take it again if the user push on the macro button twice....I hope that you understand me
Thanks for replay
Mahmoud
Comment by: Jan Karel Pieterse (5-12-2007 02:49:33) deeplink to this comment
Hi Mahmoud,
I think you would be helped best if you ask your question in one of the newsgroups or forums on internet.
See my links page for some links to newsgroups.
Comment by: Mahmoud (5-12-2007 14:50:21) deeplink to this comment
Thanks a lot Jan
Best Regards
Mahmoud
Comment by: Craig (15-2-2008 03:23:12) deeplink to this comment
I love this solution and prior to excel2003, it worked great. My company just upgraded to Excel2003 and the test program produces the error "Object Library Invalid or contains references to object definitions that could not be found". Help! I need this code to work in Excel 2003!
Comment by: Rikkart (22-2-2008 07:58:06) deeplink to this comment
Great stuff, just finding it, and then the workaround!
I couldn't figure out what was wrong, I'll definitely be back here for my next issue!
Comment by: ambar (25-6-2008 03:04:47) deeplink to this comment
Hi ,
i want to compare two ranges in two different excel files how do i dothat
Comment by: Jan Karel Pieterse (25-6-2008 03:11:49) deeplink to this comment
Hi Ambar,
Check out:
http://www.cpearson.com/excel/download.htm
Comment by: Gordon Heffron (21-11-2008 15:40:34) deeplink to this comment
The web page titled "Getting a range from the user with VBA (Bug in " discusses the "object library invalid or contains references to objects..." problem (in Excel 2003 SP3 for me). I have a program I developed a couple of years ago which ran fine. Revisiting it today I get this error, which here involves establishing a CommandBar. I have uninstalled Office 2003 and re-installed it using "setup.exe /f...." and also reinstalled it from the source CD, but no joy either way! The comment by Rickkart in this web page that "the proposal solved the problem" is great, but the problem presented wasn't my problem. Which part of the solution would solve my problem? And how can I find which line(s) of code is the offender?
Many many thanks in advance, the frustration is galling!
Comment by: Jan Karel Pieterse (22-11-2008 03:01:39) deeplink to this comment
Hi Gordon,
Have you tried Help, detect and repair from Excel? I have had several reports like these where that fixed the problem. An alternative cause to the problem might be related to the file itself. Have you tried cleaning the code in that file using Rob Bovey's code cleaner:
http://www.appspro.com/Utilities/CodeCleaner.htm
Comment by: Al Gorny (15-6-2009 07:55:30) deeplink to this comment
Hello Sir,
Your coding “GetARange.zip”, modWorkaround1, appears to be the solution I was looking for.
My problem is I do not know how to use the result in another module.
What I would like to do is have the selected range copied so that my own module then pastes the values from the selected range.
How can this be done?
Thank you in advance for any assistance you can offer.
Al Gorny
Comment by: Jan Karel Pieterse (15-6-2009 08:40:54) deeplink to this comment
Hi Al,
What you do is:
- Copy the form called ufSelectCells from the sample file to your project (you can drag the form from my project to yours in the Vsiual Basic editor)
- Copy the module called "modWorkaround1" to your project too.
- In modWorkaround1 there is a little sub called "Test" which shows exactly how to use the function.
Comment by: Al Gorny (15-6-2009 14:09:42) deeplink to this comment
RE: Comment by: Jan Karel Pieterse (6/15/2009 8:40:54 AM)
Thank you for the response.
Obviously I was not clear with my question.
Sorry.
I had no difficulty doing what you said: "- Copy the form called ufSelectCells …etc.
These tasks had been performed and inserted into Workbook1.xls as part of my project with the resultant module being incorporated and named “Test”.
Here is what’s happening:
I open Workbook1.xls that contains the macros “MyTask” and your macro “Test”.
Within Workbook1.xls I run the macro “MyTask”:
Sub MyTask()
Workbooks.Open Filename:= "C:\Documents Workbook2.xls"
Sheets("Sheet1").Select
Range("A200").Select
Selection.End(xlDown).Select
Windows("Workbook1.xls").Activate
Application.Run "Workbook1.xls!Test"
‘Your module modWorkaround1 runs. The InputBox opens and I select the range I want. I receive the confirming DialogBox which says “You Selected:’[Workbook1.xls]Sheet1’!$A$43:$B52”
Selection.Copy
Windows("Workbook2.xls").Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
What actually pastes into Workbook2.xls bears no resemblance to the selected and confirmed range from "Test.". What actually pastes is whatever the active cell(s) was/were in Workbook1.xls immediately before I run “MyTask.”
However I did a bit of experimenting. IF in Workbook1.xls I 1st hightlight the range I want and then run the macro “MyTask” everything works as desired.
Any thoughts?
This is, of course, only a minor difficulty compared to the benefits “GetARange.zip" provides.
Al Gorny
Comment by: Jan Karel Pieterse (16-6-2009 01:45:04) deeplink to this comment
Hi Al,
Modify your code like this:
Dim oRangeSelected As Range
Workbooks.Open Filename:="C:\Documents Workbook2.xls"
Sheets("Sheet1").Select
Range("A200").Select
Selection.End(xlDown).Select
Windows("Workbook1.xls").Activate
If SelectARange("Please select a range of cells!", "Selecting range to copy", oRangeSelected) = True Then
oRangeSelected.Copy
Windows("Workbook2.xls").Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Else
MsgBox "You cancelled"
End If
End Sub
Comment by: Mike (27-8-2009 10:36:00) deeplink to this comment
I love your code, but I do have a question about it. Is the following senario possible?
The user clicks on the Workaround2 button, selects a range of cells, and then de-selects some of the selected cells.
When I tried to do this, the function just repeats the selected cells instead of deleting them from the selected range. Let me know if you need clarification, it is a little hard to explain this.
Comment by: Jan Karel Pieterse (7-9-2009 10:00:36) deeplink to this comment
Hi Mike,
My example file indeed does not cater for this situation. I'd suggest to use method 2 as indicated in the text.
Comment by: P K Madan (12-3-2010 03:39:54) deeplink to this comment
I want to select excel cells depending upon loop value.
For example : for i = 62 want to select A62:F62 range
and want to merge and make bold text in this range; then
for i = 85 want to select A85:F85 range
and want to merge and make bold text in this range and so on.
Kindly help how to achieve this by using Visual Basic
Thanks
P K Madan
madan_pk@rediffmail.com
Comment by: Jan Karel Pieterse (13-3-2010 10:52:00) deeplink to this comment
For example:
i=65
With Range("A" & i & ":F" & i)
.Font.Bold = True
.Merge
End With
Comment by: Gary (29-6-2010 11:35:21) deeplink to this comment
Nice piece of coding. Method 2 solved my problem exactly.
I was using Application.InputBox to select a range, but it only seems to work with individually(single) selected cells, not a contiguous range. Using your method, my code works as desired now...THANKS MUCH!
I have also learned a bit more coding by following your code usage and execution, again...thanks.
Comment by: Pankaj (5-8-2010 07:54:24) deeplink to this comment
I am new to EXCEL VBA and I am tryin to sort Column of numbers .
When I use following logic in SUB it works fine but I want to make use of that IN FUNCTION so
i tried following and when I debugged I got an ERROR 91 :Object variable or with block variable not set..
Public Function sort4() As Range
Dim rg As Range
For I = 2 To 6
For j = I + 1 To 6
If (Worksheets("Sheet1").Cells(j, 2)) < (Worksheets("Sheet1").Cells(I, 2)) Then
temp = Worksheets("Sheet1").Cells(I, 2)
Worksheets("Sheet1").Cells(I, 2) = Worksheets("Sheet1").Cells(j, 2)
Worksheets("Sheet1").Cells(j, 2) = temp
End If
Next j
Next I
Set rg = Worksheets("Sheet1").Range("B2:B6")
sort4 = rg
End Function
Comment by: Jan Karel Pieterse (16-8-2010 04:25:07) deeplink to this comment
Hi Pankaj,
Change this line:
sort4 = rg
To:
Set sort4 = rg
NB: I would use Excel's built-in sort method to do the sort, much quicker.
Comment by: Vijay (6-10-2010 04:43:36) deeplink to this comment
Hi,
Can you please give me a code which can delete the rows based on multiple conditions.
Fro example:Column Q contains values like "BPODWSTRIAL","BPOSTRIAL","PTSFT30","Slab credits" & "Trial Credits".macro should delete the row which contains these value.......Is it possible???
Comment by: Jan Karel Pieterse (7-10-2010 02:09:51) deeplink to this comment
Hi Vijay,
Please visit http://www.eileenslounge.com to ask questions like these!
Comment by: Scott Solberg (3-12-2010 06:24:30) deeplink to this comment
Hello,
I found a bug in the "Method 2" macro which I found here:
https://jkp-ads.com/articles/SelectARange.asp
I included the commented-out old code, and the new code
which works better below:
' If user selects entire rows or columns, then the returned address,
' while still in R1C1 form, *appears* to be in A1 form, because
' it will either be C1:C3 or C1:C2,C5 or R2:R7 etc.
' so that the Application.Range(address) function thinks that the
' "C" or "R" refer to columns "C" or "R" !!
' So, one must *always* convert the range to A1 format before using
' the Application.Range() method.
' **** old code ******
' Set rInput = Application.Range(sAddr) ' will fail if R1C1 address
' If rInput Is Nothing Then ' so, must first convert to A1 reference style
' sAddr = Application.ConvertFormula(sAddr, xlR1C1, xlA1)
' Set rInput = Application.Range(sAddr)
' bGotRng = Not rInput Is Nothing
' Else
' bGotRng = True
' End If
' ***** end of old code *****
' so, use this code instead:
sAddr = Application.ConvertFormula(sAddr, xlR1C1, xlA1)
Set rInput = Application.Range(sAddr)
If rInput Is Nothing Then GoTo errH
bGotRng = True
----------------------
Otherwise, this routine by Peter Thorton works well,
and hopefully would avoid the bug caused by conditional formatting which you described.
Comment by: Ganesh (23-8-2011 04:24:44) deeplink to this comment
Hello. I want to select only the formulas in a range.Kindly suggest me the VBA code.Thanks in advance.
Comment by: Jan Karel Pieterse (23-8-2011 05:50:46) deeplink to this comment
Have a look at the SpecialCells method of the Range object:
Range("A1:Z100").Specialcells(xlCellTypeFormulas).Select
Comment by: narendra (13-10-2011 07:49:38) deeplink to this comment
Hi,
I am trying to create macro witch control location of output of an action by using cell value,
As i have created copy macro,its copying range"A4":"A18" Values and pasting at "E5" cell,
Sub copy()
'
' copy Macro
'
'
Range("A4:A18").copy
Range("E5").Select
ActiveSheet.Paste
End Sub
What i want to do is,
consider,cell "B10" having valuve Like "X10 or Y10 or Z10" witch is variable as per requarment and i want to use the paste location as per Value of "B10" witch is X10 or Y10 or Z10 or may other as per value of cell "B10" witch is variable as per requarment.
please hlep me in this,
Hoping for yours reply.
Thanks & Regards,
Narendra Chavan,
nvcworld@gamil.com
Comment by: Jan Karel Pieterse (14-10-2011 02:01:09) deeplink to this comment
HI Narandera,
I think you need this:
Sub copy()
Range("A4:A18").copy Destination:=Range(Range("B10").Value)
End Sub
Comment by: Rich Newsome (5-12-2011 16:29:43) deeplink to this comment
I use VBA to create new sheet if it does not exist already, or clear it if it does:
On Error Resume Next
Worksheets("Summary").Activate
If Not Err = 0 Then
Worksheets.Add , Worksheets(2), 1, xlWorksheet
Worksheets(3).Name = "Summary"
Err.Clear
Else
Worksheets("Summary").Clear
End If
Set xlWs = Worksheets("Summary")
Worksheets("Summary").Activate
Worksheets("Summary").UsedRange.Delete
Then I want to use standard column formats from master sheet
Sheets("Prior Material Log").Select
Range("A1:BB1").Select
Selection.Copy
Sheets("Summary").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
but VBA exits on Range("A1:BB1").Select
Nothing I try to do to the sheet (set column widths and names) works; Is there a property that I have missed that locks the sheet for editing after it is created. I recordered the macro and it still will not change when I call the method
Comment by: Jan Karel Pieterse (6-12-2011 08:35:11) deeplink to this comment
Hi Richie,
Instead of xlPasteAllUsingSourceTheme, try using xlPasteColumnWidths
If that works, copy that entire pastespecial line of code and change the xlPaste constant to the other one(s) you need, repeating the entire pastespecial line for each pastespecial type you need.
Comment by: Anthony (13-7-2012 03:21:00) deeplink to this comment
Wow. This is awesome. But one thing I still have problem. I use your modWorkround2 for my macro as Cut-Paste method. But I wanna know that is it anyway to make the selected cell deactivate? This is because when at the selection range part, the previous selected range will not change when I click on other range of cell. And the data will not paste where the range I input into the appear dialog box. Hope you can give me some example.
Thank you,
Anthony
Comment by: Max (2-8-2012 17:28:57) deeplink to this comment
Hi,
I need your help. I have a task to collect data from a website(www.yelp.com)with some search criteria.
For eg: Search for "Restaurants" in Location "Oahu".
From the result page i have to go through each restaurants link and get contact details, such as "Restaurant name, address, phone, and website of each one. all these data should be in a single excel worksheet. I think it can be done with the help of a macro, Could you please give me a solution.
Thanks in advance.
Comment by: Jan Karel Pieterse (7-8-2012 11:16:38) deeplink to this comment
@Anthony: I am not saure I understand your problem, can you please try to rephrase your question for me?
@Max: Does this page help:
www.jkp-ads.com/articles/webquery.asp
Comment by: Anthony (8-8-2012 08:45:25) deeplink to this comment
OK. I mean that when I run the macro, can the we exclude the cell when the select cell dialog box appear?? I mean that the cell where we selected before run that macro. Can we avoid that selection??
Comment by: Jan Karel Pieterse (8-8-2012 13:12:55) deeplink to this comment
Hi Anthony,
If you mean you do not want the code to enter a default address in the box, either omit this part:
sDefault = "=" & Application.Selection.Address
' InputBox cannot handle address/formulas over 255
If Len(sDefault) > 240 Then
sDefault = "=" & Application.ActiveCell.Address
End If
ElseIf TypeName(Application.ActiveSheet) = "Chart" Then
sDefault = " first select a Worksheet"
Else
sDefault = " Select Cell(s) or type address"
End If
or omit this code:
.StartAddress = Selection.Address(External:=True)
End If
Depending on which solution you used.
Comment by: TheJugglingSteve (7-12-2012 11:56:01) deeplink to this comment
hmm, I was getting the same issue - thanks for mentioning the 'elaborate conditional formatting', as that's solved my issue!
Basically my code had been copying and pasting cells with conditional formatting, and eventually the conditional formatting list had become *full*. My code was then crashing when trying to copy and add a 'new' rule to the list. Simple enough to solve though - before I ask it to apply the new rule, I'll get it to clear conditional formatting on all copied cells.
Comment by: None (28-12-2013 11:54:31) deeplink to this comment
Method 2 is working only within the same "Excel" - Application Object.
It's not possible to select a range from a second (running) MS Excel instance.
If you use InputBox with the Type 8 .. this is possible.
Comment by: Jaap (24-1-2014 10:30:57) deeplink to this comment
Hello Jan Karel,
This is a good tool. I would like to use the selection to print a selection of the sheet.
I think i must replace "MsgBox "You selected:" & oRangeSelected.Address(, , , True)" with a print command.
Please tell me how to do this.
Thanks in advance
Comment by: Jan Karel Pieterse (24-1-2014 13:56:09) deeplink to this comment
Hi Jaap,
You're close:
Comment by: John (31-1-2014 05:26:31) deeplink to this comment
Jan Karel I am really grateful for your work on this horrible issue. Has this bug really been fixed 2007 onwards? Unfortunately I have a task that might be opened in 2003.
At first I wanted to use Method 2 but then I found it didn't handle the selection of entire rows but I found your Method 1 did.
Cheers
John
Comment by: Bill (8-4-2014 16:23:05) deeplink to this comment
Hi Jan Karel,
I am using a VBA macro to retrieve the contents of a status field in an Excel worksheet. If the status field contains a value less than 255 characters, it returns the entire status. When the status field contains 255 characters or more, it returns #VALUE!. How can I retrieve the entire status field?
This is part of the code:
Option Explicit
Global Proj_Status As Variant
Sub GetProjectData()
Dim filename As String
Dim filepath As String
Dim i As Integer
Dim r As Long
For i = 2 To r
DoEvents
filepath = ""
filepath = Sheet1.Cells(i, 1)
filename = Sheet1.Cells(i, 4)
path = Sheet1.Cells(i, 5)
Stage = Sheet1.Cells(i, 3)
Call MetaData(filepath, filename, path, Stage)
End Sub
Sub MetaData(filepath As String, filename As String, path As String, Stage As String)
Proj_Status = GetInfoFromClosedFile(path, filename, "MR5 - Monthly Status Report", Left(Columns(14).Address(, 0), 1) & 30)
End Sub
Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbname As String, _
wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbname) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbname & "]" & _
wsName & "'!" & range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
If GetInfoFromClosedFile = "Total" Then Exit Function
If GetInfoFromClosedFile = "" Or GetInfoFromClosedFile = " " Then
GetInfoFromClosedFile = 0
End If
End Function
Thanks,
Bill
Comment by: Jan Karel Pieterse (9-4-2014 07:20:52) deeplink to this comment
Hi Bill,
The function you are using to get info from a closed file has limitations; one of them obviously is the number of characters in the cell you have it return. One way to overcome this is by placing a direct formula link in a cell to the workbook in question. Do this manually the first time like so:
- Open file in question
- hit = on a cell in the macro file and navigate to the other file, click on the cell you need and press enter
- CLose the file with the source data
- now look at the formula you just created
This will tell you how to build the formula from code.
Comment by: Michael (6-5-2018 16:21:14) deeplink to this comment
Just wanted to say thanks a million for an absolutely fantastic site and sharing your knowledge with the rest of us. I've learned a great deal from your site.
Comment by: Jan Karel Pieterse (7-5-2018 07:26:50) deeplink to this comment
Hi Michael,
Thanks! And you're welcome.
Have a question, comment or suggestion? Then please use this form.
If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.