macro help

  • Thread starter Thread starter lostinmacro
  • Start date Start date
L

lostinmacro

I would like to be able to have a window open to select the Range for
Range("A10:B10").Select and then have the other susequent ranges follow this
choice.
Any help thanks

Sub dvnsert()
'
' dvnsert Macro
'
' Keyboard Shortcut: Ctrl+Shift+D
'

Range("A10:B10").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A10").Select
ActiveCell.FormulaR1C1 = "DV"
Range("B10").Select
ActiveCell.FormulaR1C1 = "3.14"
Range("M9").Select
End Sub
 
What does follow this choice mean?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
In other words if I chose A1:B1 then the rest of the macro would run in
those 2 cells
 
I was hoping to have something similar to an argument fuction window open
when the macro was initiated and then choose what 2 cells I want to run the
macro in
 
Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target cells with the
mouse", Type:=8)
On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1, 1).FormulaR1C1 = "DV"
.Cells(1, 2).FormulaR1C1 = "3.14"
End With
End If
End Sub


--
---
HTH

Bob

__________________________________________
UK Cambridge XL Users Conference 29-30 Nov
http://www.exceluserconference.com/UKEUC.html

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target cells with the
mouse", Type:=8)
On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1, 1).FormulaR1C1 = "DV"
.Cells(1, 2).FormulaR1C1 = "3.14"
End With
End If
End Sub


Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target cells with the
mouse", Type:=8)
On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1, 1).FormulaR1C1 = "DV"
.Cells(1, 2).FormulaR1C1 = "3.14"
End With
End If
End Sub


Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target cells with the
mouse", Type:=8)
On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1, 1).FormulaR1C1 = "DV"
.Cells(1, 2).FormulaR1C1 = "3.14"
End With
End If
End Sub

Getting a sytacs error on the set target line
 
Set Target = Application.InputBox("Select the 2 target cells with the
mouse", Type:=8)

Must be all one line....word wrap gotcha.


Gord Dibben MS Excel MVP
 
That line has wrapped around on the newsgroups - it should be one line
up to the closed bracket, or you can split it like this:

Set Target = Application.InputBox("Select the 2 target cells with
the _
mouse", Type:=8)

(i.e. put an underscore at the end of the first line).

Hope this helps.

Pete
 
Pete

You can't have a continuation mark inside a bracketed line.

Try this revision............

Set Target = Application.InputBox _
(Select the 2 target cells with the mouse ", Type:=8)

Or this for two lines in the inputbox.................

Set Target = Application.InputBox("Select the 2 target" & vbLf _
& "cells with the mouse ", Type:=8)


Gord
 
Thanks for that correction, Gord - I see that it split in my post,
anyway, making it even more confusing !!

Pete
 
Set Target = Application.InputBox("Select the 2 target cells with
the _
mouse", Type:=8)

=========================================
Here is the way I have it now getting compile error
=====================================

Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target cells with
the _
mouse", Type:=8)


On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1, 1).FormulaR1C1 = "DV"
.Cells(1, 2).FormulaR1C1 = "3.14"
End With
End If
End Sub
 
You guys are real close what I have happening now is where I goto insert the
cells it deleting the data that is in those cells.
Here is the way it is now

Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target" & vbLf _
& "cells with the mouse ", Type:=8)



On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1, 1).FormulaR1C1 = "DV"
.Cells(1, 2).FormulaR1C1 = "3.14"
End With
End If
End Sub
 
Maybe..............?

Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target" & vbLf _
& "cells with the mouse ", Type:=8)

On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1).Offset(-1, 0).FormulaR1C1 = "DV"
.Cells(2).Offset(-1, 0).FormulaR1C1 = "3.14"
End With
End If
End Sub

BTW..........these two lines throw an error in my Excel 2003

.TintAndShade = 0
.PatternTintAndShade = 0


Gord
 
Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox("Select the 2 target" & vbLf _
& "cells with the mouse ", Type:=8)

On Error GoTo 0
If Not Target Is Nothing Then

With Target

.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Cells(1).Offset(-1, 0).FormulaR1C1 = "DV"
.Cells(2).Offset(-1, 0).FormulaR1C1 = "3.14"
End With
End If
End Sub

I hope you have a sence of humor. ok the insert is perfect except the color
doesn't go to the second cell just the first and the 2 cells that get
shifted down
 
Yep, you're right.

There has to be a better way of coding, but this revision does work.

Sub dvnsert()
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox _
("Select the 2 cells with the mouse ", Type:=8)

On Error GoTo 0
If Not Target Is Nothing Then

Target.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

With Target.Cells(1).Offset(-1, 0)
.FormulaR1C1 = "DV"
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = 255
End With

With Target.Cells(2).Offset(-1, 0)
.FormulaR1C1 = "3.14"
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = 255
End With
End If
End Sub


Gord
 
Dim Target As Range

On Error Resume Next
Set Target = Application.InputBox _
("Select the 2 cells with the mouse ", Type:=8)

On Error GoTo 0
If Not Target Is Nothing Then

Target.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

With Target.Cells(1).Offset(-1, 0)
.FormulaR1C1 = "DV"
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = 255
End With

With Target.Cells(2).Offset(-1, 0)
.FormulaR1C1 = "3.14"
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = 255
End With
End If
End Sub

That works perfect. I am so sorry I couldn't repair some of the good code
you gave me. I have 2 engineering degrees and am also a mcse but new to
Visual basic. If yo ever need advice on drilling an oil well let me know lol
 
Back
Top