Need Label Maker Macro only to apply to rows created today OR on the filter

[jp12ok]

I'm working on automatically creating labels, I've got the bulk of it down where it sources the information I want, creates a new label sheet and appropriately puts the information on the label. The only problem is that it does this for EVERY row every time. Because it is sourcing from a master log, this log could become quite large over time.

I need it to only create labels for data entered on the current day (I put in a date stamper macro already). OR only create labels for the filtered visible rows. Either or is fine, I just need a solution so that I have some control over which rows it makes labels for.

Im new to VBA, I adjusted a code I found online to create this, and I've probably spent close to 12 hours tinkering with this thing. Please help.

Here is the code Im working with:

Option Explicit

Sub FillOutTemplate()

Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String

Application.ScreenUpdating = False  'speed up macro execution
Application.DisplayAlerts = False   'no alerts, default answers used

Set dSht = Sheets("Sheet3")           'sheet with data on it starting in row2
Set tSht = Sheets("Box Label")        'sheet to copy and fill out


    LastRw = dSht.Range("H" & Rows.Count).End(xlUp).Row
    
    For Rw = 2 To LastRw
        tSht.Copy After:=Worksheets(Worksheets.Count)   'copy the template
        With ActiveSheet                                'fill out the form
            'edit these rows to fill out your form, add more as needed
            .Name = dSht.Range("A" & Rw)
            .Range("H7:I13").Value = dSht.Range("B" & Rw).Value
            .Range("B7:G13").Value = dSht.Range("C" & Rw).Value
            .Range("B3:G5").Value = dSht.Range("D" & Rw).Value
            .Range("F17:H22").Value = dSht.Range("F" & Rw).Value
            .Range("A7:A13").Value = dSht.Range("H" & Rw).Value
        End With
        
        If MakeBooks Then       'if making separate workbooks from filled out form
            ActiveSheet.Move
            ActiveWorkbook.SaveAs SavePath & Range("B3").Value, xlNormal
            ActiveWorkbook.Close False
        End If
        Cnt = Cnt + 1
    Next Rw

    dSht.Activate
    If MakeBooks Then
        MsgBox "Workbooks created: " & Cnt
    Else
        MsgBox "Worksheets created: " & Cnt
    End If
    
Application.ScreenUpdating = True
End Sub

 

[Alan_P]

Hi jp12ok,

Both options below;

Option Explicit

Sub FillOutTemplate()

Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String

Application.ScreenUpdating = False  'speed up macro execution
Application.DisplayAlerts = False   'no alerts, default answers used

Set dSht = Sheets("Sheet3")           'sheet with data on it starting in row2
Set tSht = Sheets("Box Label")        'sheet to copy and fill out


    LastRw = dSht.Range("H" & Rows.Count).End(xlUp).Row
    
    For Rw = 2 To LastRw
    
        'check if hidden/filtered
[COLOR="#FF0000"]        If Cells(Rw, "A").EntireRow.Hidden = True Then
            GoTo NextRow
        End If[/COLOR]
        
        'or

        'check if cell value is todays date
[COLOR="#FF0000"]        If Cells(Rw, "A").Value <> Date Then 'change column to the one with the date
            GoTo NextRow
        End If[/COLOR]
        
        
        tSht.Copy After:=Worksheets(Worksheets.Count)   'copy the template
        With ActiveSheet                                'fill out the form
            'edit these rows to fill out your form, add more as needed
            .Name = dSht.Range("A" & Rw)
            .Range("H7:I13").Value = dSht.Range("B" & Rw).Value
            .Range("B7:G13").Value = dSht.Range("C" & Rw).Value
            .Range("B3:G5").Value = dSht.Range("D" & Rw).Value
            .Range("F17:H22").Value = dSht.Range("F" & Rw).Value
            .Range("A7:A13").Value = dSht.Range("H" & Rw).Value
        End With
        
        If MakeBooks Then       'if making separate workbooks from filled out form
            ActiveSheet.Move
            ActiveWorkbook.SaveAs SavePath & Range("B3").Value, xlNormal
            ActiveWorkbook.Close False
        End If
        Cnt = Cnt + 1
        
[COLOR="#FF0000"]NextRow:[/COLOR]
    Next Rw

    dSht.Activate
    If MakeBooks Then
        MsgBox "Workbooks created: " & Cnt
    Else
        MsgBox "Worksheets created: " & Cnt
    End If
    
Application.ScreenUpdating = True
End Sub

Hope this helps,
Cheers,
Alan.