How to create a button which adds new 'cards' on my spreadsheet?

Question

I am creating a card based database system and I want to use a button to basically be able to new cards, as seen here.

I have already created a button and assigned a macro to it, which when clicked adds a new row of these 'cards'. However, I need my macro to be dynamic whereby the new cards are always added 3 rows down from the previous row of cards. How can this be done?

Here is my code for the macro:

 Range("B66:F75").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
End With
Range("B66:F75").Select
Range("F75").Activate
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
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B66").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Name:"
Range("B67").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Email:"
Range("B68").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Institution:"
Range("B70").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Research Focus:"
Range("B73").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Expertise:"
Range("B75").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Relevant Links:"
Range("B66:F75").Select
Selection.Copy
Range("H66").Select
ActiveSheet.Paste
Range("N66").Select
ActiveSheet.Paste
Range("W68").Select

I presume what needs to change is the range, to make it dynamic.

Does the blue coloration always extend for two rows beneath the current card or is the entire sheet filled? — Emily Alden, Jan 07 '19 at 13:50
The entire sheet is filled with blue, here is perhaps a better screenshot - https://imgur.com/a/d6Hu6pi. Hope that clarifies — Deeke, Jan 07 '19 at 13:53
This doesn't answer your question, but have a read about [avoiding the use of `Select`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — jsheeran, Jan 07 '19 at 13:53
Hmmm... Are you starting from a sheet that already has some cards or are you starting in a sheet with no text like the image you just linked? — Emily Alden, Jan 07 '19 at 13:55
It is for a sheet that already has some cards, only decided halfway through that the use of the button would be useful. Of course can clear the previously made cards though. — Deeke, Jan 07 '19 at 13:56
Well if you were starting from a blank sheet you could do a loop of. "Every 5 lines put in this text", but if you are starting from a partially filled one you would want to start with detecting the last line. — Emily Alden, Jan 07 '19 at 13:58
Try writing the loop for yourself first, but feel free to comment if you need any help. — Emily Alden, Jan 07 '19 at 14:01
What I'd do is make one card on a hidden sheet that you can just copy and paste. Then write a little routine to find where to copy and paste that card to. You don't need to dynamically create this. — Ryan Wildry, Jan 07 '19 at 14:31

score 0 · Accepted Answer · answered Jan 07 '19 at 16:40

OP mentioned in comments that it can start from a blank sheet. So here is my solution.

I assume the entire spreadsheet if filled with the medium blue color so the code does not add that.

Option Explicit

Sub CreatingCards()

'Basic idea is that we will create a base row and then copy paste it "x" times.

Dim TotalRows As Long 'How many rows of cards to generate

Dim lRow As Long 'Used to keep track of the last row of text
Dim p As Long 'Used for looping

TotalRows = 4

With ActiveSheet.Range("B6:F15")
    .Interior.ThemeColor = xlThemeColorAccent5
    .Interior.TintAndShade = 0.799981688894314
    .BorderAround Weight:=xlThin
End With

'Add Words
ActiveSheet.Range("B6").Value = "Name:"
ActiveSheet.Range("B7").Value = "Email:"
ActiveSheet.Range("B8").Value = "Institution:"
ActiveSheet.Range("B10").Value = "Research Focus:"
ActiveSheet.Range("B13").Value = "Expertise:"
ActiveSheet.Range("B15").Value = "Releveant Links:"

'Bold Headers
ActiveSheet.Range("B6").Font.Bold = True
ActiveSheet.Range("B7").Font.Bold = True
ActiveSheet.Range("B8").Font.Bold = True
ActiveSheet.Range("B10").Font.Bold = True
ActiveSheet.Range("B13").Font.Bold = True
ActiveSheet.Range("B15").Font.Bold = True

'Generate the other two cards in the row
ActiveSheet.Range("B6:F15").Copy
ActiveSheet.Range("H6").PasteSpecial xlPasteAll
ActiveSheet.Range("N6").PasteSpecial xlPasteAll

For p = 1 To TotalRows - 1 'Because we generated the first row of cards already

lRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Defines lRow as the last row with text in it.

Range("B6:R15").Copy
Range("B" & lRow + 3).PasteSpecial xlPasteAll  'Putting +3 allows for two blank rows between each card.

Next p


End Sub

How to create a button which adds new 'cards' on my spreadsheet?

1 Answers1