Repeating macro for adding rows & columns

GaryCarbon

New Member
Joined
Sep 8, 2014
Messages
1
Hello folks,

I've noticed a few posts on this topic but I've not been able to solve my problems so far so apologies if I've duplicated another post!

I'm trying to design a spreadsheet for some of my clients to use to help them record information from a number of sites. What I want to be able to do is to have them click a button and a new site field appears at the bottom of the list on the first sheet and a new table is added on a second sheet. I've managed to record a macro to do this once, but I've not been able to get it to loop or repeat itself and add the information to the next blank section.

Because I'm not sure how well I've articulated what I want it to do please see below for example

Sheet 1
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Button[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Site 1[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]

Sheet2
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Site 1[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]Jan[/TD]
[TD]x[/TD]
[TD]y[/TD]
[TD]z[/TD]
[/TR]
[TR]
[TD]Feb[/TD]
[TD]x[/TD]
[TD]y[/TD]
[TD]z[/TD]
[/TR]
</tbody>[/TABLE]

After using the button I want it to repeatedly add information into the next blank space as below
Sheet1
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Button[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Site 1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Site 2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Site 3[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]

Sheet 2
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Site 1[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]Site 2[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]Site 3[/TD]
[TD]etc[/TD]
[/TR]
[TR]
[TD]Jan[/TD]
[TD]x[/TD]
[TD]y[/TD]
[TD]z[/TD]
[TD][/TD]
[TD]x[/TD]
[TD]y[/TD]
[TD]z[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Feb[/TD]
[TD]x[/TD]
[TD]y[/TD]
[TD]z[/TD]
[TD][/TD]
[TD]x[/TD]
[TD]y[/TD]
[TD]z[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



This is what I have so far that just adds one new row & all associated formatting:

Code:
 Range("A5:M5").Select
    Selection.AutoFill Destination:=Range("A5:M6"), Type:=xlFillDefault
    Range("A5:M6").Select
    Sheets("Data").Select
    Range("B2:J4").Select
    Selection.Copy
    Range("K2").Select
    ActiveSheet.Paste
    Range("K5:S16").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Does anyone have any advice on how I can make this repeat? Some clients need this for about 400 sites so the more automatic I can make it the better!
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
I've cleaned up the code a bit, but I still don't follow exactly what you want

Code:
Sub MM1()
Range("A5:M5").AutoFill Destination:=Range("A5:M6"), Type:=xlFillDefault
Sheets("Data").Range("B2:J4").Copy Destination:=Range("K2")
With Range("K5:S16").Borders
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,171
Messages
6,170,479
Members
452,332
Latest member
The2ndQuest

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top