Active range/selection?

A

anita

Hi,

I would like to have a macro which picks up my selected range in a
workbook, similair to the activecell. So when I select a range in my
workbook, it will be set as range in my macro.


I've tried active.range but this doens't work (something like this: Set
dd = Active.Range). I can't find it in the list properties/methods in
vba.
Could somebody help me?
Thanks in advance.
 
R

Richard Buttrey

Hi,

I would like to have a macro which picks up my selected range in a
workbook, similair to the activecell. So when I select a range in my
workbook, it will be set as range in my macro.


I've tried active.range but this doens't work (something like this: Set
dd = Active.Range). I can't find it in the list properties/methods in
vba.
Could somebody help me?
Thanks in advance.
Click to expand...

If your range is a contiguous range with no columns or rows with null
values, then with the active cell somewhere in the range you could use

Set dd = ActiveCell.CurrentRegion


HTH

__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________
 
A

anita

Hi Roger and Richard,

Thank you both for the quick respons. In my macro it doens't really
work as I hoped it to be. When I run this macro he only activates the
first cell and fills in a 1 if it has the beneath conditions. Maybe I'm
doing something wrong. Below is my macro:

Sub oke()
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("arnhem12")

Set d = ActiveCell.CurrentRegion

For Each c In d
If c.Interior.ColorIndex = xlNone And _
c.Borders(xlEdgeLeft).Weight = xlThin And _
c.Borders(xlEdgeLeft).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeTop).LineStyle = xlContinuous And _
c.Borders(xlEdgeTop).Weight = xlThin And _
c.Borders(xlEdgeTop).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
c.Borders(xlEdgeBottom).Weight = xlThin And _
c.Borders(xlEdgeBottom).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeRight).LineStyle = xlContinuous And _
c.Borders(xlEdgeRight).Weight = xlThin And _
c.Locked = False And _
c.Borders(xlEdgeRight).ColorIndex = xlAutomatic Then
c.Value = 1
End If
Next c
ActiveSheet.Protect ("arnhem12")
MsgBox ("Finished")
Application.ScreenUpdating = True

End Sub

Greetings anita

Roger Govier schreef:
 
A

anita

Hi Roger and Richard,

Thank you both for the quick respons. In my macro it doens't really
work as I hoped it to be. When I run this macro he only activates the
first cell and fills in a 1 if it has the beneath conditions. Maybe I'm
doing something wrong. Below is my macro:

Sub oke()
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("arnhem12")

Set d = ActiveCell.CurrentRegion

For Each c In d
If c.Interior.ColorIndex = xlNone And _
c.Borders(xlEdgeLeft).Weight = xlThin And _
c.Borders(xlEdgeLeft).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeTop).LineStyle = xlContinuous And _
c.Borders(xlEdgeTop).Weight = xlThin And _
c.Borders(xlEdgeTop).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
c.Borders(xlEdgeBottom).Weight = xlThin And _
c.Borders(xlEdgeBottom).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeRight).LineStyle = xlContinuous And _
c.Borders(xlEdgeRight).Weight = xlThin And _
c.Locked = False And _
c.Borders(xlEdgeRight).ColorIndex = xlAutomatic Then
c.Value = 1
End If
Next c
ActiveSheet.Protect ("arnhem12")
MsgBox ("Finished")
Application.ScreenUpdating = True

End Sub

Greetings anita

Roger Govier schreef:
 
R

Richard Buttrey

Assuming all the line formatting is set as per the macro parameters,
then that suggests that the first cell is the only one which is
unlocked.

Check the others, (Format-->Cells Protection Tab) and confirm that
they are all unlocked and if so post back. Otherwise the macro would
appear to be working correctly, i.e only setting a '1' for the only
cell which is unlocked.

HTH

Hi Roger and Richard,

Thank you both for the quick respons. In my macro it doens't really
work as I hoped it to be. When I run this macro he only activates the
first cell and fills in a 1 if it has the beneath conditions. Maybe I'm
doing something wrong. Below is my macro:

Sub oke()
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("arnhem12")

Set d = ActiveCell.CurrentRegion

For Each c In d
If c.Interior.ColorIndex = xlNone And _
c.Borders(xlEdgeLeft).Weight = xlThin And _
c.Borders(xlEdgeLeft).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeTop).LineStyle = xlContinuous And _
c.Borders(xlEdgeTop).Weight = xlThin And _
c.Borders(xlEdgeTop).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
c.Borders(xlEdgeBottom).Weight = xlThin And _
c.Borders(xlEdgeBottom).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeRight).LineStyle = xlContinuous And _
c.Borders(xlEdgeRight).Weight = xlThin And _
c.Locked = False And _
c.Borders(xlEdgeRight).ColorIndex = xlAutomatic Then
c.Value = 1
End If
Next c
ActiveSheet.Protect ("arnhem12")
MsgBox ("Finished")
Application.ScreenUpdating = True

End Sub

Greetings anita

Roger Govier schreef:
Click to expand...

__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________
 
A

anita

Hi Richard,

Yes, that could be it. I the meanwhile I have found another solution,
see below. I have use activewindow.rangeselection.address and it works.
Thanks for your support and the time you've been putting in it.

Sub oke()
' Keyboard Shortcut: Ctrl+e

Application.ScreenUpdating = False
ActiveSheet.Unprotect ("x")
a = ActiveWindow.RangeSelection.Address
Range("C13").Select
Set d = Range(a)

For Each c In d
If c.Interior.ColorIndex = xlNone And _
c.Borders(xlEdgeLeft).Weight = xlThin And _
c.Borders(xlEdgeLeft).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeTop).LineStyle = xlContinuous And _
c.Borders(xlEdgeTop).Weight = xlThin And _
c.Borders(xlEdgeTop).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
c.Borders(xlEdgeBottom).Weight = xlThin And _
c.Borders(xlEdgeBottom).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeRight).LineStyle = xlContinuous And _
c.Borders(xlEdgeRight).Weight = xlThin And _
c.Locked = False And _
c.Borders(xlEdgeRight).ColorIndex = xlAutomatic Then
c.Value = 1
End If
Next c
ActiveSheet.Protect ("x")
MsgBox ("Finished")
Application.ScreenUpdating = True

End Sub

Greetings anita

Richard Buttrey schreef:
 
R

Richard Buttrey

Hi,

It looks like you could also simplify and replace all that borders
stuff with

If c.Borders.LineStyle = xlContinuous And c.Locked = False Then
c.Value = 1

all on one code line

Rgds


Hi Richard,

Yes, that could be it. I the meanwhile I have found another solution,
see below. I have use activewindow.rangeselection.address and it works.
Thanks for your support and the time you've been putting in it.

Sub oke()
' Keyboard Shortcut: Ctrl+e

Application.ScreenUpdating = False
ActiveSheet.Unprotect ("x")
a = ActiveWindow.RangeSelection.Address
Range("C13").Select
Set d = Range(a)

For Each c In d
If c.Interior.ColorIndex = xlNone And _
c.Borders(xlEdgeLeft).Weight = xlThin And _
c.Borders(xlEdgeLeft).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeTop).LineStyle = xlContinuous And _
c.Borders(xlEdgeTop).Weight = xlThin And _
c.Borders(xlEdgeTop).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
c.Borders(xlEdgeBottom).Weight = xlThin And _
c.Borders(xlEdgeBottom).ColorIndex = xlAutomatic And _
c.Borders(xlEdgeRight).LineStyle = xlContinuous And _
c.Borders(xlEdgeRight).Weight = xlThin And _
c.Locked = False And _
c.Borders(xlEdgeRight).ColorIndex = xlAutomatic Then
c.Value = 1
End If
Next c
ActiveSheet.Protect ("x")
MsgBox ("Finished")
Application.ScreenUpdating = True

End Sub

Greetings anita

Richard Buttrey schreef:
Click to expand...

__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________
 
A

anita

Hi richard,

Yes, that's better and much shorter. Thanks again.

Greetings anita

Richard Buttrey schreef:
 
Top