Insert copied formatting at specified interva

Microsoft Office excel 2003
August 9, 2010 at 08:50:11
Specs: Windows XP
Hi,

I'm trying to create an automated wire frame builder in Excel 2003 that will allow people to show me how they would like webpages to be displayed out. There are 8 different template options to choose from. I want the sheet to be able to insert the first option at "A26" and copy the template froma hidden worksheet (I've managed to get the copy macro working with the following code).

Worksheets("Template Options").Range("A19:O32").Copy _
Destination:=ActiveCell

My problem is, the next time a user clicks a button to insert a template I would like the new table (no data) to be inserted 2 rows below where the first ends and so on. In therory the user can make the page as deep as they like.

Does anyone have any ideas that might help me? I'm very new to all of this VBA stuff so sorry if its a simple thing.

I think I'm getting far too advanced for my knowledge base now but I'd like to thanks Humar for all his help on my other questions (the guy is great!!!)

Thanks

Kieran


See More: Insert copied formatting at specified interva

Report •

#1
August 9, 2010 at 09:10:22
Here are a couple of ways of finding the last cell that contains data in a given column, along with how you would "move" 2 cells down:

Option Explicit
Sub LastRow()
Dim rngEnd As Range
Dim lastA_row As Integer
'Setting the last cell as a Range
 Set rngEnd = Worksheets("Sheet1") _
        .Range("A" & CStr(Application.Rows.Count)).End(xlUp)
'Return the Address
   MsgBox rngEnd.Address
'Return the Address 2 Rows down
   MsgBox rngEnd.Offset(2, 0).Address
'Returning an integer representing the Last Row
 lastA_row = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Return the row
   MsgBox lastA_row
Return the Row 2 Rows down
   MsgBox lastA_row + 2
End Sub


Report •

#2
August 9, 2010 at 09:45:27
Hi,

I need some clarification.

You have a button that a user can click and this copies a range of cells ("A19:O32") from the template worksheet to cell A26, or is it to the Active cell.

Once that range has been copied is there some process for selecting another range of cells - or is it "A19:O32" again,

and then pasting the range starting two rows below the last range.

This means that ranges of cells from the template are pasted at A26, A42, A58 and so on.

If your user is selecting different ranges from the template, are they selecting names from a drop-down list that then have to be 'converted' to ranges to copy.

Can you explain what new table (no data) means - is it just a range of formatted cells ...

Regards


Report •

#3
August 10, 2010 at 00:56:42
Thanks guys all your help is really appreciated!!

There is a choice of 12 buttons that the user can hit to select different formatting. It's just setting a differnent number of columns along the page depending how they would like their webpage lay out to look.

It's a case of arranging merged cells and borders. I thought the best way to bring these into my work sheet would be to draw them all on another hidden sheet and use a macro to copy and paste the formatting in to the design sheet when required. Each of the 12 buttons will copy the formatting from a different range on the hidden sheet. Everything is selected from a different button.

The way the macro has been written at the moment is to paste the formatting to the active cell. However what I reall want is for the first option to be placed at A26 then any subsequent row would automatically start 2 rows below where the first finishes and so on.

In theory the user could pace as many tables as they like in to the page but I wouldnd expect any more than about 5.


Report •

Related Solutions

#4
August 13, 2010 at 06:59:20
Hi,

OK, so each of the buttons will paste a different range from the hidden worksheet. The Copy and Paste will be a Paste-Special - Formatting.

Each time one of the 12 buttons is clicked, a new format is applied - starting 2 rows below the last.

One way of doing this would be to use a cell on the hidden worksheet to keep track of the positions.

The following macro is for a button on Worksheet "Sheet1" which copies a range of cells named "Btn1" from a worksheet named "Templates", to a position 2 rows after the last template, or to row 1 if this was the first button to be clicked.

I used named ranges, as this means that the templates can be changed in size - and as long as they retain the same range name, the code does not have to be adjusted.

Each button (I tested it with three buttons) has identical code apart from using a different named range.
The named range is setup once for each button on this line:

    'setup the named range for this button
    Set rngFmt = .Range("Btn1")

Change as required for each of the 12 buttons.

Here is the code for one button:

Private Sub CommandButton1_Click()
Dim intStartRow As Integer
Dim rngFmt As Range

'get position information and save new position information
With Worksheets("Templates")

    'setup the named range for this button
    Set rngFmt = .Range("Btn1")
    
    'get last row info. from cell AA1 on Template worksheet
    'test if not used yet
    If .Range("AA1").Value = "" Then
        'start at row 1
        intStartRow = 1
        'set AA1 to number of rows in Template +2
        .Range("AA1").Value = rngFmt.Rows.Count + 2
        Else
        'there is a value so start there
        intStartRow = .Range("AA1").Value
        'add number of rows in template +2 to AA1
        .Range("AA1").Value = _
                .Range("AA1").Value + rngFmt.Rows.Count + 2
    End If

'Copy named range
rngFmt.Copy
End With

'paste formatting
Worksheets("Sheet1").Range("A" & intStartRow) _
        .PasteSpecial Paste:=xlPasteFormats

End Sub

If users were able to 'start over' there would need to be a button to clear the transferred formats (including removing any merged cells), and to reset cell AA1 on the Templates worksheet back to empty ("").

If you had an undo button, so that users could undo the last format copied, you could use a range of cells on the Templates worksheet to hold the names of the ranges copied.

The undo button would find the last named range, calculate it's size and position and clear it, as well as resetting AA1 to the last start position.

Hope this might be of some use to you.

Regards


Report •

#5
August 13, 2010 at 07:09:38
Hi,

Here is an alternative button code which saves position and applied format information, so that you can add an undo button:

Private Sub CommandButton1_Click()
Dim intStartRow As Integer
Dim rngFmt As Range
Dim intTable As Integer

'get position information and save new position information
With Worksheets("Templates")

    'setup the named range for this button
    Set rngFmt = .Range("Btn1")
    
    'get last row info. from cell AA1 on Template worksheet
    'test if not used yet
    If .Range("AA1").Value = "" Or .Range("AA1").Value = 0 Then
        'start at row 1
        intStartRow = 1
        'set AA1 to number of rows in Template +2
        .Range("AA1").Value = rngFmt.Rows.Count + 2
        Else
        'there is a value so start there
        intStartRow = .Range("AA1").Value
        'add number of rows in template +2 to AA1
        .Range("AA1").Value = _
                .Range("AA1").Value + rngFmt.Rows.Count + 2
    End If
    
    'save start position and copied range name to a table
    'AB1 has count of formats copied
    If .Range("AB1").Value = "" Or .Range("AB1").Value = 0 Then
        .Range("AB1").Value = 1
        intTable = 1
        Else
        intTable = .Range("AB1").Value
    End If
    'save paste information
    .Range("AB1").Offset(intTable, 0).Value = rngFmt.Name.Name
    .Range("AB1").Offset(intTable, 1).Value = intStartRow
    .Range("AB1").Value = .Range("AB1").Value + 1
    
'Copy named range
rngFmt.Copy
End With

'paste formatting
Worksheets("Sheet1").Range("A" & intStartRow) _
        .PasteSpecial Paste:=xlPasteFormats

End Sub

and here is the code for an Undo button:

Private Sub CB_Undo_Click()
Dim rngFmt As Range
With Worksheets("Templates")
    'test to see if any templates copied
    If .Range("AA1").Value = "" Or .Range("AA1").Value = 1 Then
        'no formats copied so exit
        Exit Sub
        Else
        'create range to clear using table entries
        'get last applied format range
        Set rngFmt = .Range(.Range("AB1").Offset(.Range("AB1").Value - 1, 0))
        'clear range based on last start row and last applied format size
        Worksheets("Sheet1").Range("A" & .Range("AB1") _
            .Offset(.Range("AB1").Value - 1, 1).Value) _
            .Resize(rngFmt.Rows.Count, rngFmt.Columns.Count).ClearFormats
    End If
    'update table and next row pointer
    'reset next row
    .Range("AA1").Value = .Range("AA1").Value - rngFmt.Rows.Count - 2
    'reset the table
    .Range("AB1").Offset(.Range("AB1").Value - 1, 0).Clear
    .Range("AB1").Offset(.Range("AB1").Value - 1, 1).Clear
    .Range("AB1").Value = .Range("AB1").Value - 1

End With
End Sub

Regards


Report •

#6
August 16, 2010 at 02:50:10
This is perfect and working exactly how I wanted it, thank you so much :) Just one quick question when I'm using the reset button, how can I tell it to reset all of the cleared cells to colorIndex 15. I know I'm going to have to insert the line

.ColorIndex = 15

Somewhere but everywhere I'm trying it I'm getting a bug and it doesn't like it, I'm trying various positions in this section of VBA

'create range to clear using table entries
'get last applied format range
Set rngFmt = .Range(.Range("AB1").Offset(.Range("AB1").Value - 1, 0))
'clear range based on last start row and last applied format size
Worksheets("Sheet1").Range("A" & .Range("AB1") _
.Offset(.Range("AB1").Value - 1, 1).Value) _
.Resize(rngFmt.Rows.Count, rngFmt.Columns.Count).ClearFormats

But it just isn't working, I'd assume that I'd want to add it at the end after clearing the formats to then recolor the range I've just cleared. Something like:

.Rang("AB1").ColorIndex = 15

as the next line. I just can't see why this wont work for me.

Any ideas?

Thanks


Report •

#7
August 16, 2010 at 04:04:48
Hi,

The ColorIndex to change the cell background colour must be applied to the cell's 'Interior' parameter, so:
Interior.ColorIndex=15

The 'Interior' parameter applies to a range, so you have to use the same range as used for clear. Here is the whole line, with a preceding comment line, (note that a space followed by an underscore is a line continuation, so all of this after the comment is treated as one line of code):

        'reset cell colour to colour index 15
        Worksheets("Sheet1").Range("A" & .Range("AB1") _
            .Offset(.Range("AB1").Value - 1, 1).Value) _
            .Resize(rngFmt.Rows.Count, rngFmt.Columns.Count) _
            .Interior.ColorIndex = 15

I also noticed that my code did not start the formats at row 26, as originally stated.

Here is a button code and the Undo button code, revised to use row 26 as the origin:

Private Sub CommandButton1_Click()
Dim intStartRow As Integer
Dim rngFmt As Range
Dim intTable As Integer

'get position information and save new position information
With Worksheets("Templates")

    'setup the named range for this button
    Set rngFmt = .Range("Btn1")
    
    'get last row info. from cell AA1 on Template worksheet
    'test if not used yet
    If .Range("AA1").Value = "" Or .Range("AA1").Value = 0 Then
        'start at row 26
        intStartRow = 26
        'set AA1 to number of rows in Template +26 +2
        .Range("AA1").Value = rngFmt.Rows.Count + 28
        Else
        'there is a value so start there
        intStartRow = .Range("AA1").Value
        'add number of rows in template +2 to AA1
        .Range("AA1").Value = _
                .Range("AA1").Value + rngFmt.Rows.Count + 2
    End If
    
    'save start position and copied range name to a table
    'AB1 has count of formats copied
    If .Range("AB1").Value = "" Or .Range("AB1").Value = 0 Then
        .Range("AB1").Value = 1
        intTable = 1
        Else
        intTable = .Range("AB1").Value
    End If
    'save paste information
    .Range("AB1").Offset(intTable, 0).Value = rngFmt.Name.Name
    .Range("AB1").Offset(intTable, 1).Value = intStartRow
    .Range("AB1").Value = .Range("AB1").Value + 1
    
'Copy named range
rngFmt.Copy
End With

'paste formatting
Worksheets("Sheet1").Range("A" & intStartRow) _
        .PasteSpecial Paste:=xlPasteFormats

End Sub

Private Sub CB_Undo_Click()
Dim rngFmt As Range
With Worksheets("Templates")
    'test to see if any templates copied
    If .Range("AA1").Value = "" Or .Range("AA1").Value = 26 Then
        'no formats copied so exit
        Exit Sub
        Else
        'create range to clear using table entries
        'get last applied format range
        Set rngFmt = .Range(.Range("AB1").Offset(.Range("AB1").Value - 1, 0))
        'clear range based on last start row and last applied format size
        Worksheets("Sheet1").Range("A" & .Range("AB1") _
            .Offset(.Range("AB1").Value - 1, 1).Value) _
            .Resize(rngFmt.Rows.Count, rngFmt.Columns.Count).ClearFormats
        'reset cell colour to colour index 15
        Worksheets("Sheet1").Range("A" & .Range("AB1") _
            .Offset(.Range("AB1").Value - 1, 1).Value) _
            .Resize(rngFmt.Rows.Count, rngFmt.Columns.Count) _
            .Interior.ColorIndex = 15
    End If
    'update table and next row pointer
    'reset next row
    .Range("AA1").Value = .Range("AA1").Value - rngFmt.Rows.Count - 2
    'reset the table
    .Range("AB1").Offset(.Range("AB1").Value - 1, 0).Clear
    .Range("AB1").Offset(.Range("AB1").Value - 1, 1).Clear
    .Range("AB1").Value = .Range("AB1").Value - 1

End With
End Sub

If you do want to use the revised code for a row 26 origin, clear all the date in columns AA, AB & AC, and clear all existing formats on Sheet1 before re-starting.

Regards


Report •

Ask Question