Home |
Search |
Today's Posts |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
In the first version:
Replace this: With Range(OldRange1, OldRange2) .Copy _ Destination:=NewRange .Value = .Value End With with: With Range(OldRange1, OldRange2) .Copy _ Destination:=NewRange.cells(1,1) .Value = .Value End With Excel will figure out the correct size based on copied range. But I'd use the second version... Dave Peterson wrote: Maybe... Option Explicit Sub MonthlyAvailReport2() Dim OldRange1 As Range Dim OldRange2 As Range Dim NewRange As Range Set OldRange1 = Application.InputBox _ (prompt:="Enter the first column of last month's figures in format R1", _ Type:=8) Set OldRange2 = Application.InputBox _ (prompt:="Enter the last column of last month's figures in format T100", _ Type:=8) Set NewRange = Application.InputBox _ (prompt:="Enter next column in format U1", Type:=8) With Range(OldRange1, OldRange2) .Copy _ Destination:=NewRange .Value = .Value End With End Sub I removed some of the .selects and just worked on the ranges directly. But you may want to add a few validation checks to make protect your macro from user error: Option Explicit Sub MonthlyAvailReport2() Dim OldRange1 As Range Dim OldRange2 As Range Dim NewRange As Range Set OldRange1 = Nothing On Error Resume Next Set OldRange1 = Application.InputBox _ (prompt:="Enter the first column of last month's" _ & " figures in format R1", Type:=8).Cells(1, 1) On Error GoTo 0 If OldRange1 Is Nothing Then 'user hit cancel Exit Sub End If Set OldRange2 = Nothing On Error Resume Next Set OldRange2 = Application.InputBox _ (prompt:="Enter the last column of last month's" _ & " figures in format T100", Type:=8).Cells(1, 1) On Error GoTo 0 If OldRange2 Is Nothing Then 'user hit cancel Exit Sub End If 'oldrange1 and oldrange2 have to be in the same workbook & worksheet If OldRange1.Parent.Parent.Name < OldRange2.Parent.Parent.Name _ Or OldRange1.Parent.Name < OldRange2.Parent.Name Then MsgBox "Please select the two ranges on the same worksheet!" Exit Sub End If Set NewRange = Nothing On Error Resume Next Set NewRange = Application.InputBox _ (prompt:="Enter next column in format U1", Type:=8).Cells(1, 1) On Error GoTo 0 If NewRange Is Nothing Then 'user hit cancel Exit Sub End If With Range(OldRange1, OldRange2) .Copy _ Destination:=NewRange .Value = .Value End With End Sub I also changed the oldrange1 and oldrange2 and newrange to just the first cell of each selection. wal50 wrote: I want to to prompt the user for a range to copy, copy that range to a new column, then change the original range to values. It gets hung up on the line Range("OldRange1:OldRange2").Select. I tried prompting for the whole OldRange(R1:T100) but couldn't get that to work so I tried what you see below and got further down. I suppose I have an incorrect syntax, so would the same answer apply to the Range("Old/NewRange").select statements that follow it? This is a modified Recorded macro so it's probably clumsy but you've got to start somewhere. Your help is appreciated. Sub MonthlyAvailReport2() ' ' MonthlyAvailReport2 Macro ' Prepare monthly report new columns, values. Dim OldRange1 As Range Dim OldRange2 As Range Dim NewRange As Range Set OldRange1 = Application.InputBox _ (prompt:="Enter the first column of last month's figures in format R1", Type:=8) Set OldRange2 = Application.InputBox _ (prompt:="Enter the last column of last month's figures in format T100", Type:=8) Set NewRange = Application.InputBox _ (prompt:="Enter next column in format U1", Type:=8) Range("OldRange1:OldRange2").Select Selection.Copy Range("NewRange").Select ActiveSheet.Paste Range("OldRange").Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False End Sub -- Dave Peterson -- Dave Peterson |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
duplicate effort | Excel Discussion (Misc queries) | |||
A little more effort... | Excel Programming |