Create and Fill an Excel Form Based on Variable Data Using VBA Code

[Henz1]

I am using VBA in Excel to take information from a log (sheet1) and create a new form based off of a template. The information is not static, in other words I am unable to use .FormulaR1C1 to define cell locations from which to populate the form. As I am a novice, I used Record Macro to help start the structure for this macro, but am now having a hard time converting the .FormulaR1C1 into something more flexible. As can be seen in the following code, I have created various Dim to allow for the variables, but I'm not sure this will really get me to the end result I am looking for.

I have successfully created the new spreadsheet and named it, but now I do not know how to identify the new sheet and the selected cells and create a formula to make them equal cells from sheet1 that are located wherever my cursor happens to be.

Sub CreateRFI()
'
' CreateRFI Macro
' Creates an RFI based off of infromation in this sheet.
'
 
'
Dim i As Integer
i = Range("A" & ActiveCell.Row).Value
 
Sheet_name_to_create = "RFI " & i
 
Dim submitted, due As Date
submitted = Range("C" & ActiveCell.Row).Value
due = Range("D" & ActiveCell.Row).Value
 
Dim description As String
description = Range("B" & ActiveCell.Row).Value
 
For rep = 1 To (Worksheets.Count)
    If LCase(Sheets(rep).Name) = LCase(Sheet_name_to_create) Then
    MsgBox "This sheet already exists.  Please create new RFI or delete existing sheet."
    Exit Sub
    End If
Next
 
Sheets("RFI Log").Select
    Sheets("RFI Template").Visible = True
    Sheets("RFI Template").Select
    Range("A1:J46").Select
    Range("J46").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Sheets(ActiveSheet.Name).Select
    Sheets(ActiveSheet.Name).Name = Sheet_name_to_create
    [COLOR=#b22222]Range("H8:I9").Select
    ActiveCell.FormulaR1C1 = "='RFI Log'!R[117]C[-7]"
    Range("G10:H10").Select
    ActiveCell.FormulaR1C1 = "='RFI Log'!R[115]C[-4]"
    Range("B17").Select
    ActiveCell.FormulaR1C1 = "='RFI Log'!R[108]C"
    Range("H17").Select
    ActiveCell.FormulaR1C1 = "='RFI Log'!R[108]C[-4]"[/COLOR]
    Range("H18").Select
    Sheets("RFI Template").Select
    ActiveWindow.SelectedSheets.Visible = False
End Sub

The end result is that once the form is created, I would like the cells identified in the code above to have a formula in them such that any changes to the log (sheet1) would effect the appropriate changes to the newly created sheet.

Thank you in advance for any help.

 

[AlphaFrog]

I think this is what you are asking for. It concatenates the Active Cell's row number in the formulas. I cleaned up a few other things as well. TIP: the code doesn't have to .Select a range to copy\paste to it.

[COLOR=darkblue]Sub[/COLOR] CreateRFI()
[COLOR=green]'[/COLOR]
[COLOR=green]' CreateRFI Macro[/COLOR]
[COLOR=green]' Creates an RFI based off of infromation in this sheet.[/COLOR]
[COLOR=green]'[/COLOR]
 
[COLOR=green]'[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] rep [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Sheet_name_to_create [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] submitted, due [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] description [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [B][COLOR=darkblue]Dim[/COLOR] r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    r = ActiveCell.row[/B]
    Sheet_name_to_create = "RFI " & Range("A" & r).Value
    description = Range("B" & r).Value
    submitted = Range("C" & r).Value
    due = Range("D" & r).Value
     
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] rep [COLOR=darkblue]In[/COLOR] Worksheets
        [COLOR=darkblue]If[/COLOR] LCase(rep.Name) = LCase(Sheet_name_to_create) [COLOR=darkblue]Then[/COLOR]
            MsgBox "This sheet already exists. " & vbLf & _
                   "Please create new RFI or delete existing sheet.", _
                   vbExclamation, "Sheet Already Exists"
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR]
    
    Sheets("RFI Template").Range("A1:J46").Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
    Range("A1").PasteSpecial Paste:=xlPasteAll
    ActiveSheet.Name = Sheet_name_to_create
    Range("H8:I9").FormulaR1C1 = "='RFI Log'!R[B]" & r & "[/B]C[-7]"
    Range("G10:H10").FormulaR1C1 = "='RFI Log'!R[B]" & r & "[/B]C[-4]"
    Range("B17").FormulaR1C1 = "='RFI Log'!R[B]" & r & "[/B]C"
    Range("H17").FormulaR1C1 = "='RFI Log'!R[B]" & r & "[/B]C[-4]"
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[Henz1]

Thank you, AlphaFrog. That worked wonderfully. I had to modify it slightly due to an image that is in the template sheet, but you did not lead me astray. I do have a question, though, do you know why on sheet1 I am no longer able to use ctrl+z to undo? In fact the undo button has been grayed out. Does it have to do with the

Dim rep As Worksheet

?

By-the-way, here is the code I am currently using:

Sub CreateRFI()
'
' CreateRFI Macro
' Creates an RFI based off of infromation in this sheet.
'
 
'
    Dim rep As Worksheet
    Dim Sheet_name_to_create As String
    Dim submitted, due As Date
    Dim description As String
    Dim r As Long
    
    r = ActiveCell.Row
    Sheet_name_to_create = "RFI " & Range("A" & r).Value
    description = Range("B" & r).Value
    submitted = Range("C" & r).Value
    due = Range("D" & r).Value
     
    For Each rep In Worksheets
        If LCase(rep.Name) = LCase(Sheet_name_to_create) Then
            MsgBox "This sheet already exists. " & vbLf & _
                   "Please create new RFI or delete existing sheet.", _
                   vbExclamation, "Sheet Already Exists"
            Exit Sub
        End If
    Next
    
    Sheets("RFI Template").Range("A1:J46").Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    ActiveSheet.Name = Sheet_name_to_create
    Range("H8:I9").FormulaR1C1 = "='RFI Log'!R" & r & "C[-7]"
    Range("G10:H10").FormulaR1C1 = "='RFI Log'!R" & r & "C[-4]"
    Range("B17").FormulaR1C1 = "='RFI Log'!R" & r & "C"
    Range("H17").FormulaR1C1 = "='RFI Log'!R" & r & "C[-4]"
    Range("A20").Select
        
End Sub

 

[AlphaFrog]

Thank you, AlphaFrog. That worked wonderfully. I had to modify it slightly due to an image that is in the template sheet, but you did not lead me astray. I do have a question, though, do you know why on sheet1 I am no longer able to use ctrl+z to undo? In fact the undo button has been grayed out. Does it have to do with the

Dim rep As Worksheet

?

You're welcome.

You want to "undo" the macro? Why? Or is it just the shortcut Ctrl+z doesn't work anymore?