Instructions and Macro Code for Romeo

To use the following code :-

Open the Excel Workbook containing the Report(s)

Open the VBE (Visual Basic Editor) alt+F11

Paste the attached code into an existing Module in the VBE or create a new one

You may have to insert some Blank lines for readability

Go back to the Worksheet

Select View ---> Macros

“Click” on the Macro Name and Select --->Options

Enter a shortcut key of your choice to start the Macro from the Keyboard

Select OK then Close and Select a Worksheet containing a Report

Select a Cell within the Report

Type the Shortcut Key combination

Select a Cell within another Report

Type the Shortcut Key combination

Have Fun !!Any feedback is welcome.

Macro Code

Sub SelectandFormat()

'Setup Variables

Dim CellRng As Range

Dim ColRng As Range

Dim RowRng As Range

Dim Rowcnt As Long

Dim Colcnt As Long

On Error Resume Next

'If a Table Exists Convert the Table to a Range

ActiveSheet.ListObjects("Table1").Unlist

'Reset the Error Flag

On Error GoTo 0

'Save the Cursor Position in a Range Object

Set CellRng = ActiveCell

'Reset All Background Colors

Cells.Interior.Color = RGB(255, 255, 255)

'Select the Cursor Position

CellRng.Select

With Selection

'Create a Table of the Data

   Selection.CurrentRegion.Select

   ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Table1"

   Range("Table1[#All]").Select

   ActiveSheet.ListObjects("Table1").TableStyle = ""

   ActiveSheet.ListObjects("Table1").Name = "Table1"

End With

CellRng.Select

'Convert the "Sheet" Column and Row Addresses to "Table" Column and Row Addresses

Rowcnt = (CellRng.Row - Range("Table1").Row) + 1

Colcnt = (CellRng.Column - Range("Table1").Column) + 1

'Setup the Column and Row Ranges within the Table as Objects and set the Colours

Set ColRng = ActiveSheet.ListObjects("Table1").ListColumns(Colcnt).Range

ColRng.Interior.Color = RGB(299, 255, 204)

Set RowRng = ActiveSheet.ListObjects("Table1").ListRows(Rowcnt).Range

RowRng.Interior.Color = RGB(299, 255, 204)

CellRng.Interior.Color = RGB(255, 204, 229)

'Stitch the Ranges Together

Application.Union(CellRng, ColRng, RowRng).Select

'Tidy Up

'Remove Table

ActiveSheet.ListObjects("Table1").Unlist

CellRng.Select

 'Reset Objects

Set CellRng = Nothing

Set ColRng = Nothing

Set RowRng = Nothing

End Sub