macro help

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
 
B

Bob Phillips

What does follow this choice mean?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
L

lostinmacro

In other words if I chose A1:B1 then the rest of the macro would run in
those 2 cells
 
L

lostinmacro

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
 
B

Bob Phillips

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)
 
L

lostinmacro

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
Click to expand...

Getting a sytacs error on the set target line
 
G

Gord Dibben

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
 
P

Pete_UK

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
 
G

Gord Dibben

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
 
P

Pete_UK

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

Pete
 
L

lostinmacro

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

=========================================
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
 
L

lostinmacro

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
 
G

Gord Dibben

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
 
L

lostinmacro

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
Click to expand...

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
 
G

Gord Dibben

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
 
L

lostinmacro

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
Click to expand...

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Can Vba workout if a selection is part of a group? 0
Macro Loop 1
Static references into variables 4
HUGE macro 13
Macro should Save and Overwrite file 1
excel macro missing worksheets 9
Macros in Excel 2
Filename Problem In a Macro 4

Top