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!!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.