so i need to get a range from the user, how is it possible to query the user to select a range, something like"
dim x as range
x = getrange("Select Range to Compare")
msgbox "The range selected is " & x
is there a way to do this?
You may try something like this. Tweak it as per your requirement.
Sub AskUserToSelectARangeToWorkWith()
Dim Rng As Range
On Error Resume Next
Set Rng = Application.InputBox("Select a Range to compare.", "Select A Range!", Type:=8)
If Rng Is Nothing Then
MsgBox "You didn't select a Range.", vbCritical, "No Range Selected!"
Exit Sub
End If
MsgBox "The Range selected is " & Rng.Address(0, 0)
End Sub
Related
I'm trying to mark cells from a column then store the range into a variable. I would like to use the variable for another macro to calculate the average from the given range.
Sub UserRang()
Dim SelRange As Range
Set SelRange = Selection
Rng1 = SelRange.Address
MsgBox "You selected: " & Rng1
End Sub
Sub GradeAve()
GradeAverage = Application.WorksheetFunction.Average(Rng1)
MsgBox "The grade average is: " & GradeAverage
End Sub
Why can't you just use the AVERAGE worksheet function and skip the 'variable' in the middle?
ex. "=AVERAGE(A1:A5,A9,A12)"
VBA isn't great if you want to save and maintain static variables (or something resembling static variables).
Rng1needs to be declared on top of the module and should be a range not an address string as Averageneeds a range as argument.
Public Rng1 as Excel.Range
Sub UserRang()
Dim SelRange As Range
Set SelRange = Selection
Set Rng1 = SelRange
MsgBox "You selected: " & Rng1.Address
End Sub
Even better, use a function that returns the range instead of a sub.
Public Function GetUserSelection() as Excel.Range
Set GetUserSelection = Selection
End Function
Sub GradeAve()
GradeAverage = Application.WorksheetFunction.Average(GetUserSelection)
MsgBox "The grade average of " & GetUserSelection.Address & " is: " & GradeAverage
End Sub
My code below works perfectly to find a cell on a different worksheet when the string is small, however large text strings pull up an error. I have tried using error handling even just to give a MsgBox rather than open a VBA window when it errors.
Can anyone help, preferably find the cell with many characters or if not possible, put an error handler in to say something like, too large to search.
What the code does, is a have a range of cells with text in each cell. I can click on that cell, or a cell 2 columns to the right, then click the FIND button, to go in the next worksheet to find the exact same cell value. All cells are unique.
Sub Find_Cell()
Dim NA As Worksheet
Set NA = Worksheets("Notes Analysis")
LastRow = NA.Cells(Rows.Count, 2).End(xlUp).Row
On Error Resume Next
If Not Intersect(ActiveCell, Range("G19:G" & LastRow)) Is Nothing Then
Dim value As String 'Declare a string
value = ActiveCell.Offset(, -2) 'Get the value of the selected Cell
Dim ws As Worksheet
'ws is the worksheet from we are searching the value
'You have to change myWorkSheetName for you worksheet name
Set ws = ThisWorkbook.Worksheets("DEBT_SALE_ACTIVITY")
ws.Activate
Dim c As Range 'Declare a cell
Set c = ws.Cells.Find(value, LookIn:=xlValues) 'Search the value
If Not c Is Nothing Then 'If value found
c.Activate 'Activate the cell, select it
Else
MsgBox "Not found" 'shows a message "Not Found"
End If
Else
If Not Intersect(ActiveCell, Range("E19:E" & LastRow)) Is Nothing Then
Dim value2 As String 'Declare a string
value2 = ActiveCell 'Get the value of the selected Cell
Dim ws2 As Worksheet
'ws is the worksheet from we are searching the value
'You have to change myWorkSheetName for you worksheet name
Set ws2 = ThisWorkbook.Worksheets("DEBT_SALE_ACTIVITY")
ws2.Activate
Dim c2 As Range 'Declare a cell
Set c2 = ws2.Cells.Find(value2, LookIn:=xlValues) 'Search the value
If Not c2 Is Nothing Then 'If value found
c2.Activate 'Activate the cell, select it
Else
MsgBox "Not found" 'shows a message "Not Found"
End If
Else
MsgBox "Select an Account Note"
End If 'end the If for if active cell is in our notes
End If 'end the If for if active cell is in Account note
End Sub
To provide an error message indicating the text is too long you could do the following:
Add this after each statement where you assign value its value:
value = ActiveCell.Offset(, -2) 'Get the value of the selected Cell
If Len(value) > 255 Then
MsgBox "Text in cell " & CStr(ActiveCell.Address) & " is too long", vbOKOnly, "Search Text Too Long"
Exit Sub
End If
Also, you might want to change your if...then...else code structure.
Currently your code is operating like this:
If Not Intersect(ActiveCell, Range("G19:G" & LastRow)) Is Nothing Then
do things
exit sub
Else
If Not Intersect(ActiveCell, Range("E19:E" & LastRow)) Is Nothing Then
do things
exit sub
Else
MsgBox "Select an Account Note"
exit sub
Which, based on your comments for your End If's isn't exactly what your message box says. If your first if statement is Account Notes and your second if statement is notes, then a better structure would be the following.
Change this code
Else
If Not Intersect(ActiveCell, Range("E19:E" & LastRow)) Is Nothing Then
To look like this
ElseIf Not Intersect(ActiveCell, Range("E19:E" & LastRow)) Is Nothing Then
Then the statement `MsgBox "Select an Account Note" will be accurate. You also be able to delete one of your End If statements.
Your code will operate like this:
If Not Intersect(ActiveCell, Range("G19:G" & LastRow)) Is Nothing Then
do things
exit sub
ElseIf Not Intersect(ActiveCell, Range("E19:E" & LastRow)) Is Nothing Then
do things
exit sub
Else
MsgBox "Select an Account Note"
exit sub
I'm struggling to do what I believe is a simple task
I have a textbox on a user form that contains a numeric value which I wish to be used as a row number reference in a range.
Sheets("Sheet1").Range("A" & TextBox1.Value).Select
This fails with the error "Select Method of Range Class Failed"
How do I convert these values into a range?
You should look to use error handling for this
Sub Recut()
Dim rng1 As Range
If IsNumeric(textbox1.Value) Then
On Error Resume Next
Set rng1 = Sheets("Sheet1").Range("A" & textbox1.Value)
On Error GoTo 0
If rng1 Is Nothing Then MsgBox "A" & textbox1.Value & " is invalid"
Else
MsgBox "Textbox does not contain a number"
End If
End Sub
I have this code which allows to a copy a customized range from any sheet and paste it to a fixed range on sheet 2. This code works but I need to implement paste link function in this code, so that if i want to make any changes to the data in DB it will auto update in sheet 2 as well. Here is the code I have done so far. Thank you in advance
Sub CustomizedInputFixedoutput()
Dim rng As Range, _
inp As Range, _
ws As Worksheet
Set inp = Selection
On Error Resume Next
Set rng = Application.InputBox("Copy to", Type:=8)
On Error GoTo 0
If TypeName(rng) <> "Range" Then
MsgBox "Cancelled", vbInformation
Exit Sub
Else
rng.Parent.Activate
rng.Copy
Sheets("Sheet 2").Range("B2:N5").Value = rng.Value
End If
Application.CutCopyMode = False
End Sub
I felt sure this had to be a duplicate but searching [excel-vba] Paste Link found a few questions without any accepted answers and none that matched to OP desire to paste into a specific range.
Option Explicit
Sub CustomizedInputFixedoutput()
Dim CopyRng As Range
Dim PasteRng As Range
Dim Msg As String
Dim Response As VbMsgBoxResult
Set CopyRng = Selection
On Error Resume Next
Set PasteRng = Application.InputBox("Select a cell to copy to", Type:=8)
On Error GoTo 0
If Not PasteRng Is Nothing Then 'user clicked Cancel
If PasteRng.Count > 1 Then
'Get confirmation to paste to multi-cell range
Msg = "Are you sure you want to paste to " & PasteRng.Address & "?" _
& vbCrLf & vbCrLf _
& "Results may be unexpected if you proceed."
Response = MsgBox(Msg, vbQuestion + vbYesNo, "Confirm multi-cell paste range")
End If
If Response = vbYes Or PasteRng.Count = 1 Then
CopyRng.Copy
PasteRng.Parent.Activate
PasteRng.Activate
ActiveSheet.Paste Link:=True
Else
MsgBox "Cancelled", vbInformation
End If
Else
MsgBox "Cancelled", vbInformation
End If
Application.CutCopyMode = False
End Sub
Here you copy the range:
rng.Copy
And here you are assigning the value of B2:N5 the same value as rng.
Sheets("Sheet 2").Range("B2:N5").Value = rng.Value
The problem is that that code isn't pasting anything from the clipboard! You don't need to .Copy anything to assign cell values like this.
Use the Worksheet.Paste method instead of assigning the values (then the .Copy will serve its purpose), and set the optional parameter Links to True, like this:
Worksheets("Sheet 2").Range("B2:N5").Select
Worksheets("Sheet 2").Paste Links:=True
I'd like the user to input a range of cells such as A1:Z26. I've tried adding quotations, I've tried have 2 inputboxes, one for beginning and end of the range. But it errors out everytime with: 'method range of object_global failed'
I know it's a simple syntax issue (I think) so can anyone point me in the right direction in terms of how to have the user input a range that works in the set rng = range(msg)
Sub iterationLoop()
Dim rng As Range, iteration As Range
msg = "What is the range you'd like to look at: (e.g. A1:B2)"
InputBox (msg)
Set rng = Range(msg)
For Each iteration In rng
iteration.Select
If iteration = vbNullString Then
iteration = "add value"
MsgBox ("Cell: " & Selection.Address & " has no value")
End If
Next
End Sub
Application.InputBox allows you to specify the input type. Type 8 corresponds to a range. This will allow the user to either select the range with a mouse or type it in manually:
Sub test()
Dim rng As Range
Set rng = Application.InputBox("Select by mouse or enter (e.g. A1:B2) the range you'd like to look at:", Type:=8)
MsgBox rng.Address
End Sub
If you intend your code to be used by others, you should probably wrap the Application.InputBox call in some error-handling code since the above code raises a run-time error if the user presses Cancel. Something like:
On Error Resume Next
Set rng = Application.InputBox("Select by mouse or enter (e.g. A1:B2) the range you'd like to look at:", Type:=8)
If Err.Number > 0 Then
MsgBox "No Range Selected"
Exit Sub
End If
On Error GoTo 0
(though you might want to do something more useful than just quitting the sub)
aAdd
Dim rngstr as string
Then with the inputbox use this:
rngstr = inputbox(msg)
set rng = Range(rngstr)