Select cells around active cells

[Shazam]

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]

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)

[vba]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[/vba]

HTH,

[Shazam]

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]

Hi Shazam,

Easiest way:

[vba]
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[/vba]

[Shazam]

Thank You so much Ken Puls!!