Thread: First effort
View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson[_5_] Dave Peterson[_5_] is offline
external usenet poster
 
Posts: 1,758
Default First effort

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