I have been trying to copy defined range through input-box to defined range through another input-box on other sheet.
I am getting error Run-time error "'1004' Application define or object defined error". on line
rngCopyFrom.Copy ThisWorkbook.Sheets("Sheet2").Range("rngCopyTo")
My level is beginner. Please guide me in what way to change it to serve the desired objective.
Sub Sample()
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
On Error Resume Next
Set rngCopyFrom = Application.InputBox("Enter the range from which you ant to copy", Type:=8)
On Error GoTo 0
On Error Resume Next
Set rngCopyTo = 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 Shhet2
rngCopyFrom.Copy ThisWorkbook.Sheets("Sheet2").Range("rngCopyTo")
End If
End Sub
This program works If I define the fixed range as shown in line below.
rngCopyFrom.Copy ThisWorkbook.Sheets("Sheet2").Range("D2:D14")
This should work with 2 input boxes:
Option Explicit
Sub copyRangeFromInputBoxes()
Dim copyFrom As Range, copyTo As Range
Err.Clear
On Error Resume Next 'if input is cancelled
Set copyFrom = Application.InputBox("Select source range", Type:=8)
If Not copyFrom Is Nothing Then 'if not cancelled
Set copyTo = Application.InputBox("Select destination range", Type:=8)
If Not copyTo Is Nothing Then copyFrom.Copy copyTo
End If
End Sub
The code will copy from any sheet and paste on any other sheet:
Related
I have a workbook with one main index sheet and a template sheet.
I have information in my index sheet.
Each line in the main sheet should generate a new sheet.
I want to duplicate the template with all the data in there, but with a name from each line from main sheet.
I can create the sheets with the right names, but with zero data in them.
This is the VBA code to make a new sheet with the right name. I need to copy all the data into all the new sheets. It comes from this blog post by Oscar Cronquist:
'Name macro
Sub CreateSheets()
'Dimension variables and declare data types
Dim rng As Range
Dim cell As Range
'Enable error handling
On Error GoTo Errorhandling
'Show inputbox to user and prompt for a cell range
Set rng = Application.InputBox(Prompt:="Select cell range:", _
Title:="Create sheets", _
Default:=Selection.Address, _
Type:=8)
'Iterate through cells in selected cell range
For Each cell In rng
'Check if cell is not empty
If cell <> "" Then
'Insert worksheet and name the worksheet based on cell value
Sheets.Add.Name = cell
End If
'Continue with next cell in cell range
Next cell
'Go here if an error occurs
Errorhandling:
'Stop macro
End Sub
Create Template Worksheets
Sub CreateTemplateWorksheets()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ash As Object: Set ash = wb.ActiveSheet
Dim lws As Worksheet: Set lws = wb.Worksheets("Main Index")
Dim lrg As Range
Set lrg = lws.Range("A2", lws.Cells(lws.Rows.Count, "A").End(xlUp))
Dim sws As Worksheet: Set sws = wb.Worksheets("Template")
Dim lCell As Range
Dim dws As Worksheet
Dim dwsCount As Long
Dim dName As String
For Each lCell In lrg.Cells
dName = CStr(lCell.Value)
If Len(dName) > 0 Then
On Error Resume Next
Set dws = wb.Worksheets(dName)
On Error GoTo 0
If dws Is Nothing Then
sws.Copy After:=wb.Sheets(wb.Sheets.Count)
Set dws = ActiveSheet
dws.Name = dName
dwsCount = dwsCount + 1
End If
Set dws = Nothing
End If
Next lCell
ash.Select
MsgBox "Worksheets created: " & dwsCount, vbInformation
End Sub
Developing a code through which user selects a range in the active workbook. For the range selected i.e. A8:A12 i want to run a loop through which for each range in the selected range, the loop takes its value, Filters GL_Sheet's Current Region (GL_Rng) using that value and copy's the visible cells
The code is
'Declaring Workbooks
Dim GL_CY As Variant
Dim GL_Book As Workbook, Tgt_Book As Workbook
GL_CY = Application.GetOpenFilename(Title:="Open GL", FileFilter:="Excel Files (*.xls*),*xls*")
Set GL_Book = Application.Workbooks.Open(GL_CY)
Set Tgt_Book = Workbooks.Add
'Selecting Range
Dim GL_Code As Variant, GL_LR As Long, GL_Rng As range, Rng As range
Dim GL_Sheet As Worksheet, tgt As Worksheet
Set GL_Sheet = GL_Book.Worksheets(1)
GL_LR = GL_Sheet.range("B" & Rows.Count).End(xlUp).Row
Set GL_Rng = GL_Sheet.range("A4:R" & GL_LR).CurrentRegion.Offset(3, 0)
GL_Code = Application.InputBox(Prompt:="Select the range of GL codes to generate its GL activity ", Title:="Generate GL Activity", Type:=8)
' GL_Sheet.range("A3:A5").Value = range(GL_Code).Value
For Each Rng In range(GL_Code)
Set tgt = Tgt_Book.Worksheets.Add
GL_Rng.AutoFilter Field:=6, Criteria1:=GL_Code
GL_Rng.SpecialCells(xlCellTypeVisible).Copy
tgt.Paste
tgt.range("A1").CurrentRegion.Cut tgt.range("B6")
tgt.Cells.WrapText = False
tgt.Cells.Columns.AutoFit
tgt.Name = GL_Code
Application.CutCopyMode = False
Next Rng
As you can see I am struggling with the last part of the code which results in Error 1004 (Method of range...)
Naqi,
I created a little test routine to check out what was being returned from the InputBox.
Turns it was coming back as a Variant. I tried setting it as a Range but that wouldn't work either. However changing the Type:=2 (string) makes it work
Option Explicit
Sub Test()
Dim GL_Code As String
GL_Code = Application.InputBox(Prompt:="Select the range of GL codes to generate its GL activity ", _
Title:="Generate GL Activity", _
Type:=2)
Debug.Print Range(GL_Code).Address()
End Sub
'So by changing your Type to 2 the For Each rng statement should no longer create a problem.
Edit: Found an option using Type 8:
[Click here for the post I found this in.][1]
Sub MyMacro()
Dim GL_Code As Range
Set GL_Code = Application.InputBox("Select a range", "Get Range", Type:=8)
Debug.Print GL_Code.Address()
End Sub
'Since GL_Code is now a range your For Each should NOT enclose it in a Range() function!
HTH
I have been struggling with this for over an hour. I need to write a VBA code where the user selects a range and then I check if this selected range is empty before I go and do anything else.
This is what I have so far:
Sub test()
Set rng= Application.InputBox("Select the range of the raw data please", Type:=8)
If Application.WorksheetFunction.CountA(Range(rng)) > 0 Then
MsgBox "do this, this and that!"
End If
End Sub
When I run this I get a "Method Range of object_Global failed". I know it lets the user select the range just fine but the Range(rng) is not working right. Any help would be appreciated!
Your problem is that your variable rng is a range and you're trying to wrap that in a range, which is why it's throwing an error. Try this instead.
Sub test()
Dim rng As Range
Set rng = Application.InputBox("Select the range of the raw data please", Type:=8)
If Application.WorksheetFunction.CountA(rng) > 0 Then
MsgBox "do this, this and that!"
End If
End Sub
Just some code
Sub main()
Dim sentRange As Range
Set sentRange = Application.InputBox("Select the range of the raw data please", Type:=8)
If isRangeEmpty(sentRange) = False Then
MsgBox "Range is not empty."
Else
MsgBox "Good to go!"
End If
End Sub
Function isRangeEmpty(ByRef myRange As Range) As Boolean
Dim rngLoop As Range
Dim rangeEmpty As Boolean
For Each rngLoop In myRange
If rngLoop.Value = Empty Then
'All Good
isRangeEmpty = True
Else
'Need to exit
isRangeEmpty = False
Exit For
End If
Next rngLoop
End Function
If you are only acting on the instance of data being present then something like below will work. I would also adding Option Explicit to the top of your code and declare all variables.
Sub How()
Dim rng As Range
Set rng = Application.InputBox("Select Target Range", Type:=8)
If Application.WorksheetFunction.CountA(rng) <> 0 Then
'Actions
End If
End Sub
I am trying to create a VBA template that can be used to suppress all data values under a certain amount. I have found/updated some code I found online that does successfully create a new sheet, transfer the selected data, and replace all numeric values 30 and under with "< 30" as desired. However, it also updates the original data source, replacing the data selected instead of only updating the data on the new sheet. How can I prevent it from modifying the original data and only modifying the data copied to the new sheet?
I've tried this code here, but am not getting the desired results and have been unable to figure out how to modify it to achieve them:
Sub SuppressLessThan()
Dim Rng As Range
Dim WorkRng As Range
Dim ws As Worksheet
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Select the cells you are working with:", "Select Range", WorkRng.Address, Type:=8)
Set ws = Worksheets.Add
WorkRng.Copy
For Each Rng In WorkRng
If Rng.Value < 30 Then
Rng.Value = "< 30"
End If
Next
With ws.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValuesAndNumberFormats
End With
ws.Columns("A").AutoFit
Application.CopyCutMode = False
End Sub
It currently copies the selected range and updates both the original data source and new sheet with the suppressed values. How can I prevent it from modifying the original data and only transform the copied data?
Give this a try:
Sub SuppressLessThan()
Dim wb As Workbook
Dim ws As Worksheet
Dim Rng As Range
Dim WorkRng As Range
Dim dTargetNum As Double
Dim sDefault As String
dTargetNum = 30
If TypeName(Selection) = "Range" Then sDefault = Selection.Address
On Error Resume Next
Set WorkRng = Application.InputBox("Select the cells you are working with:", "Select Range", sDefault, Type:=8)
On Error GoTo 0
If WorkRng Is Nothing Then Exit Sub 'Pressed cancel
Set wb = WorkRng.Worksheet.Parent
Set ws = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
WorkRng.Copy
ws.Range("A1").PasteSpecial xlPasteValues
ws.Range("A1").PasteSpecial xlPasteFormats
ws.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
For Each Rng In ws.UsedRange.Cells
If Rng.Value < dTargetNum Then Rng.Value = "< " & dTargetNum
Next Rng
ws.UsedRange.EntireColumn.AutoFit
End Sub
In an Excel macro, how can I accept a user's choice of column, then copy that column to a new excel sheet and then repeat the proccess for a number of columns (say 7)?
Edit:
using brettdj's answer combined with the link provided by pasty I got this, which did the job:
Dim rng1 As Range
Dim NewBook As Workbook
Set rng1 = Application.InputBox("Please select a column", "User selection - entire column will be copied", Selection.Address, , , , , 8)
If Not rng1 Is Nothing Then
Set NewBook = Workbooks.Add
rng1.EntireColumn.Copy NewBook.Worksheets("Sheet1").[a1]
End If
Use Application.InputBox, something like this
Sub TrySomethingNextTime()
Dim rng1 As Range
Dim ws As Worksheet
On Error Resume Next
Set rng1 = Application.InputBox("Please select a column", "User selection - entire column will be copied", Selection.Address, , , , , 8)
On Error Goto 0
If Not rng1 Is Nothing Then
Set ws = Sheets.Add
rng1.EntireColumn.Copy ws.[a1]
End If
End Sub
brettdj answer adapted for rows:
Sub TrySomethingNextTime2()
Dim rng1 As Range
Dim ws As Worksheet
On Error Resume Next
Set rng1 = Application.InputBox("Please select a row", "User selection - entire row will be copied", Selection.Address, , , , , 8)
On Error GoTo 0
If Not rng1 Is Nothing Then
Set ws = Sheets.Add
rng1.EntireRow.Copy ws.[a1]
End If
End Sub