PDA

View Full Version : Select cells around active cells



Shazam
03-05-2006, 09:54 AM
Hey Everyone,


Now I dont know this is possible hopefully there is a code for this. Right now I'm selecting cells around active cells then I hold down the shift key and go to edit and copy picture. Is there a code that it could loop through the worksheets in the workbook and determine the active cells and it will select the cells around it? If so then I could use my other code that it will copy as picture.

I attach the file below.

Ken Puls
03-05-2006, 10:46 AM
Hi Shazam,

Try this. I'm sure you can add the loop to it. Test calls a function that returns the range, increased by one row and one column. The only kicker here is that you need to have your theoretical last cell with data in it. So say on Sheet2, you'd need to put a space (or something) in cell J37. The function will then increase the range to (A1:K38)

Sub test()
Dim rngSel As Range
Set rngSel = IncreaseUsedRange(ActiveSheet)
rngSel.Select
End Sub
Public Function IncreaseUsedRange(ws As Worksheet) As Range
'Function Purpose: Returns range from cell A1 to the last used cell
' and then increases the range by one row and one column

Dim FirstRow As Long
Dim LastRow As Long
Dim FirstColumn As Integer
Dim LastColumn As Integer

On Error Resume Next
With ws
LastRow = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

LastColumn = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set IncreaseUsedRange = Range(.Cells(1, 1), .Cells(LastRow + 1, LastColumn + 1))
End With
On Error GoTo 0

End Function

HTH,

Shazam
03-05-2006, 11:06 AM
Hi Ken Puls,


Thank You so much thats is what I'm excatly I'm looking for. I tried to loop through the worksheets it only works on the current worksheet that I run the macro on. Any Ideas how to get this to work through all the worksheets?



Sub test()
Dim rngSel As Range
Dim objSheet As Worksheet

For Each objSheet In ActiveWorkbook.Worksheets
Set rngSel = IncreaseUsedRange(ActiveSheet)
rngSel.Select
Next objSheet
End Sub
Public Function IncreaseUsedRange(ws As Worksheet) As Range
'Function Purpose: Returns range from cell A1 to the last used cell
' and then increases the range by one row and one column

Dim FirstRow As Long
Dim LastRow As Long
Dim FirstColumn As Integer
Dim LastColumn As Integer


On Error Resume Next
With ws
LastRow = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

LastColumn = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set IncreaseUsedRange = Range(.Cells(1, 1), .Cells(LastRow + 1, LastColumn + 1))
End With
On Error GoTo 0

End Function

Ken Puls
03-05-2006, 11:19 AM
Hi Shazam,

Easiest way:


Sub test()
Dim rngSel As Range
Dim objSheet As Worksheet

For Each objSheet In ActiveWorkbook.Worksheets
objSheet.Activate
Set rngSel = IncreaseUsedRange(ActiveSheet)
rngSel.Select
Next objSheet
End Sub

Shazam
03-07-2006, 09:44 PM
Thank You so much Ken Puls!!