Print For loop to immediate window

Question

I had been pondering a way to automate the creation of For Loops, specifically for copying rows from one sheet to another, based on a single criteria.

This script asks for the following information via a series of input boxes and prints a customized For Loop to the Immediate Window (which can then be pasted to a module):

1. A column with a reliable last row to measure. In most of the data sets I see this is typically column 1, but I wanted to allow flexibility here.

2. The criteria for copying rows to another sheet. For example, the presence of the word "thing to copy" in a row. This criteria must be in the same column for the row to be copied.

3. The first row of data. While this is typically row 2, I wanted to offer flexibility here.

4. The header row. While this is typically row 1, I wanted to offer flexibility here.

5. The target sheet (where rows should be copied)

6. The desired sub script name

The resulting For Loop comes out like this:

Sub ForLoopScript()
 Dim Source As Worksheet
 Dim Target As Worksheet
 Dim c As Range
 Dim CriteriaRange As Range
 Dim CriteriaString As String
 Set Source = Worksheets("source data")
 Set Target = Worksheets("target sheet")
 LastRow = Source.Cells(Rows.Count, 4).End(xlUp).Row
 With Source
 Set CriteriaRange = Source.Range(.Cells(2, 5), .Cells(LastRow, 5))
 End With
 j = 2
 For Each c In CriteriaRange
 CriteriaString = c.Text
 Select Case CriteriaString
 Case Is = "thing to copy"
 Source.Rows(c.Row).Copy Target.Rows(j)
 j = j + 1
 End Select
 Next c
 Source.Rows(1).Copy Target.Rows(1)
End Sub

I personally use this sort of For loop in most of my scripts, so I wanted to be able to customize these scripts quicker. Historically, I would just use a template I had saved as a text file, and customize it manually. Making this script has saved me time in this regard, and was also a fun challenge.

I thought I would post this here in the event anyone else finds it useful, or has critiques or suggestions for improvement. I'm curious to hear what the community thinks.

Option Explicit
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Sub ForLoopBuilder()
'source dims
 Dim SourceRange As Range
 Dim Source As Worksheet
 Dim SourceString As String
 Dim LastRowColumn As Variant
'criteria dims
 Dim CriteriaRange As Range
 Dim CriteriaString As String
 Dim FirstRow As Variant
 Dim HeaderRow As Variant
 Dim CriteriaColumn As Variant
 'target dims
 Dim TargetRange As Range
 Dim Target As Worksheet
 Dim TargetString As String
'debug dims
 Dim ScriptName As String
 Dim RangeString As String
'error handling
 On Error GoTo UserCancel
'capture source details
 Set SourceRange = Application.InputBox("Select column with last row to measure", Title:="1 Column Only", Type:=8)
 Set Source = SourceRange.Worksheet
 SourceString = Source.Name
 LastRowColumn = SourceRange.Column
'capture criteria details
 Set CriteriaRange = Application.InputBox("Select copy criteria", Title:="1 Cell Only", Type:=8)
 CriteriaString = CriteriaRange.Text
 FirstRow = Application.InputBox("First row of data?", "Enter number")
 HeaderRow = Application.InputBox("Header row?", "Enter number (0 if no header)")
 CriteriaColumn = CriteriaRange.Column
'capture target sheet details
 Set TargetRange = Application.InputBox("Select any cell in target sheet", Title:="1 Cell Only", Type:=8)
 Set Target = TargetRange.Worksheet
 TargetString = Target.Name
'capture sub name
 ScriptName = Application.InputBox("Enter script name", "Text Only")
 ScriptName = Replace(ScriptName, " ", "")
'saves criteria range as string
 RangeString = ".Range(.Cells(" & FirstRow & "," & CriteriaColumn & "),.Cells(" & "LastRow" & "," & CriteriaColumn & "))"
'prints dims to Immediate Window
 Debug.Print "Sub " & ScriptName & " ()" & vbNewLine
 Debug.Print vbTab & "Dim Source as Worksheet"
 Debug.Print vbTab & "Dim Target as Worksheet" & vbNewLine
 Debug.Print vbTab & "Dim c as Range"
 Debug.Print vbTab & "Dim CriteriaRange as Range"
 Debug.Print vbTab & "Dim CriteriaString as String" & vbNewLine
 Debug.Print vbTab & "Set Source = Worksheets(" & vbDoubleQuote & SourceString & vbDoubleQuote & ")"
 Debug.Print vbTab & "Set Target = Worksheets(" & vbDoubleQuote & TargetString & vbDoubleQuote & ")"
 Debug.Print vbTab & "LastRow = Source.Cells(Rows.Count," & LastRowColumn & ").End(xlUp).Row" & vbNewLine; ""
'print For Loop to Immediate Window
 Debug.Print vbTab & "With Source"
 Debug.Print vbTab & vbTab & "Set CriteriaRange = Source" & RangeString
 Debug.Print vbTab & "End With" & vbNewLine
 Debug.Print vbTab & "j = " & FirstRow
 Debug.Print vbTab & vbTab & "For Each c in CriteriaRange"
 Debug.Print vbTab & vbTab & vbTab & "CriteriaString = c.text"
 Debug.Print vbTab & vbTab & vbTab & vbTab & "Select Case CriteriaString "
 Debug.Print vbTab & vbTab & vbTab & vbTab & vbTab & "Case Is = " & vbDoubleQuote & CriteriaString & vbDoubleQuote
 Debug.Print vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "Source.rows(c.row).copy Target.rows(j)"
 Debug.Print vbTab & "j = j + 1"
 Debug.Print vbTab & vbTab & vbTab & vbTab & "End Select"
 Debug.Print vbTab & vbTab & vbTab & "Next c" & vbNewLine
 Select Case HeaderRow
 Case Is <> 0
 Debug.Print vbTab & "Source.Rows(" & HeaderRow & ").copy Target.Rows(" & HeaderRow & ")" & vbNewLine
 End Select
 Debug.Print "End Sub"
'notify user
 MsgBox "See immediate window for your loop script!", vbInformation, ": )"
UserCancel:
End Sub

Update: for this task, I ended up settling on a method using AutoFilter:

Option Explicit
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Sub AutoFilterPro()
'source dims
 Dim SourceRange As Range
 Dim Source As Worksheet
 Dim SourceString As String
'criteria dims
 Dim CriteriaRange As Range
 Dim CriteriaString As String
 Dim CriteriaColumn As Variant
 'target dims
 Dim TargetRange As Range
 Dim Target As Worksheet
 Dim TargetString As String
'debug dims
 Dim ScriptName As String
'error handling
 On Error GoTo UserCancel
'capture criteria details
 Set CriteriaRange = Application.InputBox("Select copy criteria", Title:="1 Cell Only", Type:=8)
 CriteriaString = CriteriaRange.Text
 CriteriaColumn = CriteriaRange.Column
 Set Source = CriteriaRange.Worksheet
 SourceString = Source.Name
'capture target sheet details
 Set TargetRange = Application.InputBox("Select any cell in target sheet", Title:="1 Cell Only", Type:=8)
 Set Target = TargetRange.Worksheet
 TargetString = Target.Name
'capture sub name
 ScriptName = Application.InputBox("Enter script name", "Text Only")
 ScriptName = Replace(ScriptName, " ", "")
'prints dims to Immediate Window
 Debug.Print "Sub " & ScriptName & " ()"
 Debug.Print vbTab & "With Worksheets(" & vbDoubleQuote & SourceString & vbDoubleQuote & ").UsedRange"
 Debug.Print vbTab & vbTab & ".AutoFilter"
 Debug.Print vbTab & vbTab & ".AutoFilter Field:=" & CriteriaColumn & ", Criteria1:=" & vbDoubleQuote & "=" & CriteriaString & vbDoubleQuote
 Debug.Print vbTab & vbTab & ".Copy Worksheets(" & vbDoubleQuote & TargetString & vbDoubleQuote & ").Range(" & vbDoubleQuote & "A1" & vbDoubleQuote & ")"
 Debug.Print vbTab & vbTab & ".AutoFilter"
 Debug.Print vbTab & "End With"
 Debug.Print "End Sub"
'notify user
 MsgBox "See immediate window for your loop script!", vbInformation, ": )"
UserCancel:
End Sub

This produces the desired effect, but more efficiently (shown below):

Sub NewSub()
 With Worksheets("source data").UsedRange
 .AutoFilter
 .AutoFilter Field:=5, Criteria1:="=thing to copy"
 .Copy Worksheets("target sheet").Range("A1")
 .AutoFilter
 End With
End Sub

• Brandon Barney: I'll give you this, it is an interesting idea to be able to accomplish this kind of task (especially if you can make it even more dynamic/able to handle more complex logic) but it also seems inefficient. You use a total of seven variables (two of which aren't declared, tsk tsk). Your worksheets variables aren't qualified (they implicitly rely on the ActiveWorkbook), and your copy method uses the inefficient Range copy (which can be a performance drain compared to using arrays). It is an interesting proof of concept, but I would argue that it would lead to copy-paste code.
• peter.domanico: @BrandonBarney Thanks Brandon, I appreciate you looking at this. I'll work to incorporate your feedback.
• Ibo: Why would you write a code that creates a code for you to do sth? You can write a code that gets stuff from the user and does the same thing you wanted, or just make it in a way that it can recognize what it should do.
• peter.domanico: @Ibo the whole point is to make sub routines quickly so they can be placed into a project. This is a development tool for me, not a tool for end users.
• peter.domanico: @BrandonBarney relevant post, if you're interested:codereview.stackexchange.com/a/164621/138859