Application.Input box to enter range for copy and paste options - vba

I have been trying to copy and paste from one sheet to another, whereby the cells should be copied with the pastelink feature, while making use of the input box to let the user enter the range where he wants to paste the copied data. The code works within the same sheet but not on a different one. Even if it works, it does not recognise the range I have entered in the input box. Instead, it recognises the cursor and pastes whereby the cursor is in the destination worksheet.
This is the code I used for the copying and pasting from sheet 1 to sheet 2. Is there any problem with the codes for which why it does not recognise the range I have entered in the input box?
Sub tryuserinput()
Dim rng As Range
Dim inp As Range
Selection.Interior.ColorIndex = 37
Set inp = Selection
Set rng = Application.InputBox("Copy to", Type:=8)
inp.Copy
rng.Select
Worksheets("Sheet2").Paste Link:=True
End Sub

Is this what you are trying?
Sub Sample()
Dim rng As Range, inp As Range
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
Else
Set inp = Selection
inp.Interior.ColorIndex = 37
End If
Set rng = Application.InputBox("Copy to", Type:=8)
If Not rng Is Nothing Then
rng.Parent.Activate
rng.Select
inp.Copy
ActiveSheet.Paste Link:=True
End If
End Sub

Revised because...I didn't research. Just use this line of code after you choose the range in other sheet.
inp.Copy Destination:=ThisWorkbook.Sheets("Sheet2").Range(rng.Address)

Related

Excel VBA - Capitalizing all selected cells in a column with formulas

I used the code from Siddharth Rout on the following thread to capitalize selected columns but ran into a Error '13' MISMATCH when I used it on a column with cells that had formulas in some of the range.
Excel VBA - Capitalizing all selected cells in column on double click
Here is the code that worked on non-formula based column data from the above link:
Sub ChangeToUpper()
Dim rng As Range
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
Set rng = Selection
rng = WorksheetFunction.Transpose(Split(UCase(Join( _
WorksheetFunction.Transpose(rng), vbBack)), vbBack))
End Sub
I searched the forums and didn't find specifics related to this. So I googled it and Mr.Excel had this code but still gave the Error '13', when I cleared out of the error message everything was capitalized. Is there a way to eliminate getting this error?
Here is the code from Mr.Excel:
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
If Len(cell) > 0 Then cell = UCase(cell)
Next cell
Application.ScreenUpdating = True
End Sub
Check If Cell has formula and or errors, If yes then ignore.
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
'/ Exclude errors
If Not IsError(cell) Then
If Len(cell) > 0 And Not cell.HasFormula Then
cell = UCase(cell)
End If
End If
Next cell
Application.ScreenUpdating = True
End Sub

Paste link VBA code not working

My paste link does not seem to work and is giving me a select method of range class failed on the specified line. I don't seem to be able to diagnose this error.
Sub CustomizedInputFixedoutputnotworking()
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
Worksheets("Sheet 2").Range("B2:N5").Select ' Code does not work at this line
Worksheets("Sheet 2").Paste Links:=True
End If
Application.CutCopyMode = False
End Sub
Try this code:
Sub CustomizedInputFixedoutputnotworking()
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.Copy ' add this line to copy the range that user selected before (with InputBox)
Worksheets("Sheet 2").Activate ' add this line to activate the target worksheet, because select method (the next line) only work in the active sheet
Range("B2:N5").Select
ActiveSheet.Paste Link:=True
End If
Application.CutCopyMode = False
End Sub
NOTE: Copy method will fail if the user select non-contiguous ranges for example A1 and B2, the simple way (not the complete way) to avoid that is by using:
Set rng = Union(rng, rng)
If rng.Areas.Count > 1 Then Exit Sub
I believe your issue is that you selected the text but never copied it to the clipboard. Even if you did copy it, the .Select method would have changed your destination.
I am hopeful a simple change to the .Copy method will resolve your issue. If not, let me know:
Worksheets("Sheet2").Range("B2:N5").Copy
Worksheets("Sheet2").Paste Link:=True
-- edit --
Based on the comment that the selected range is the "copy" (source) and B2:N5 is the destination, try this:
rng.Copy
Worksheets("Sheet2").Range("B2:N5").Select
Worksheets("Sheet2").Paste Link:=True

Get the column of a user selected cell using vba excel

Refer to this question: Let the user click on the cells as their input for an Excel InputBox using VBA.
I use this line of code Set rng = Application.InputBox(Prompt:="Select the cell you want to edit.", Title:="CELL TO EDIT", Type:=8) to ask the user to select a cell. If the cell that is selected is in column G then I will need to call a subroutine. So, I need to figure out what column the selected cell is in.
Thanks for the help!
Use rng.Column property to return column number:
Sub test()
Dim rng As Range
On Error Resume Next
Set rng = Application.InputBox(Prompt:="Select the cell you want to edit.", title:="CELL TO EDIT", Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
'column G=7
If rng.Column = 7 Then
'do something
End If
End Sub
If user can select more than one cell, change
If rng.Column = 7 Then
to
If Not Application.Intersect(rng, Sheets("Sheet1").Range("G:G")) Is Nothing Then

Copy and Paste using Input Box in Excel 2010 - VBA

Help needed. I'm a newbie to VBA and trying to start with simple macro.
But even with that failing miserably.
All i'm trying to do is copy and paste from one worksheet to another using an input box to specify the range to be copied.
Now I know for the input box is:
Application.InputBox("Enter the range from which you want to copy : ", Type:=8)
But what do line do i need in order to copy to a cell in another worksheet?
I apologise in advance for being an idiot.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim rngCopyFrom As Range
On Error Resume Next
Set rngCopyFrom = Application.InputBox("Enter the range from which you want to copy", Type:=8)
On Error GoTo 0
If Not rngCopyFrom Is Nothing Then
'~~> Copy the range to say Cell A1 of Sheets("weekly raw")
rngCopyFrom.Copy ThisWorkbook.Sheets("weekly raw").Range("A1")
End If
End Sub
One way to do it is like this:
Sub CopyRange()
Dim FromRange As Range
Dim ToRange As Range
Set FromRange = Application.InputBox("Enter the range from which you want to copy : ", Type:=8)
Set ToRange = Application.InputBox("Enter the range to where you want to copy : ", Type:=8)
FromRange.Copy ToRange
'Or you can do it like this if you need some flexibility on Paste
'FromRange.Copy
'ToRange.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
End Sub
Here's some sample code:
Option Explicit
Sub CopyStuff()
Dim x As Range
Dim y As Range
Set x = Application.InputBox("Select what copy using the mouse", Type:=8)
Set y = ActiveWorkbook.Sheets("Sheet2").Range("A1")
x.Copy y
End Sub

How to delete all row which contains "Grand Total" in Excel automatically?

In my active sheet called Report I have 2 column I & F.
It has repeating cells containing text "Grand Total".
I would like to delete whole row if it contains Grand Total automatically.
VBA code would be nice.
With the following VBA code, you can quickly delete the rows with certain cell value, please do as the following steps:
Select the range that you want to delete the specific row.
Click Developer>Visual Basic, a new Microsoft Visual Basic for applications window will be displayed, click Insert > Module, and input the following code into the Module:
VBA code to Remove entire rows based on cell value(i.e. Grand Total):
Sub Delete_Rows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A1:D22"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "Grand Total" _
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub
Then click "Play/Run" button to run the code, and the rows which have certain value have been removed.
(Note: If you can't see Developer Tab in Excel Do these Steps: 1)Click the Office Button, and then click Excel Options. 2)In the Popular category, under Top options for working with Excel, select the Show Developer tab in the Ribbon check box, and then click OK.)
Using AutoFilter is very efficient. This can also be done without VBA (ie manually)
Main Sub
Sub Main()
Dim ws As Worksheet
Dim rng1 As Range
Dim StrIn As String
Dim rng2 As Range
Set ws = Sheets("Sheet1")
Application.ScreenUpdating = False
Set rng1 = ws.Range("F:F,I:I")
StrIn = "Grand Total"
For Each rng2 In rng1.Columns
Call FilterCull(rng2, StrIn)
Next
Application.ScreenUpdating = True
End Sub
Delete Sub
Sub FilterCull(ByVal rng2, ByVal StrIn)
With rng2
.Parent.AutoFilterMode = False
.AutoFilter Field:=1, Criteria1:=StrIn
.EntireRow.Delete
.Parent.AutoFilterMode = False
End With
End Sub
This should help get you started.
http://msdn.microsoft.com/en-us/library/office/ee814737%28v=office.14%29.aspx#odc_Office14_ta_GettingStartedWithVBAInExcel2010_VBAProgramming101
Also see similar question:
Delete a row in Excel VBA