Copy, paste next record?

[erutherford]

thought it might be easier to provide the basic idea with code rather than try to explain it.

I am trying to take one record from "Entries" and paste into the "basic" worksheet, print the sheet (one per record , then clear contents for the next record to be copied and printed.

End the end I will have one printed sheet for each record in the "entries" worksheet.

Private Sub CommandButton7_Click()
Worksheets("Entries").Range("A2").Copy Worksheets("Basic").Range("B2") 'Entry
Worksheets("Entries").Range("B2").Copy Worksheets("Basic").Range("D2") 'Last Name
Worksheets("Entries").Range("C2").Copy Worksheets("Basic").Range("E2") 'First Name
Worksheets("Entries").Range("D2").Copy Worksheets("Basic").Range("B5") 'Year
Worksheets("Entries").Range("E2").Copy Worksheets("Basic").Range("C5") 'Model
Worksheets("Entries").Range("F2").Copy Worksheets("Basic").Range("D5") 'Type
Worksheets("Entries").Range("G2").Copy Worksheets("Basic").Range("E5") 'License
Worksheets("Entries").Range("H2").Copy Worksheets("Basic").Range("G5") 'Color
Worksheets("Entries").Range("I2").Copy Worksheets("Basic").Range("J5") 'Division

Worksheets("Basic").Print

Worksheets("Basic").Range("B2").ClearContents
Worksheets("Basic").Range("D2").ClearContents
Worksheets("Basic").Range("E2").ClearContents
Worksheets("Basic").Range("B5").ClearContents
Worksheets("Basic").Range("C5").ClearContents
Worksheets("Basic").Range("D5").ClearContents
Worksheets("Basic").Range("F5").ClearContents
Worksheets("Basic").Range("G5").ClearContents
Worksheets("Basic").Range("J5").ClearContents

End Sub

 

[dmt32]

Hi,
untested but try

Private Sub CommandButton1_Click()
    Dim EntriesRange As Range, BasicRange As Range
    Dim PrintCell As Range, Cell As Range
    Dim Data As Variant
    Dim i As Integer
    
    With ThisWorkbook
'basic sheet data entry range
        Set BasicRange = .Worksheets("Basic").Range("B2,D2,E2,B5,C5,D5,E5,G5,J5")
        With .Worksheets("Entries")
            Set EntriesRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
        End With
    End With
    
    For Each Cell In EntriesRange.Cells
'create array from range
        Data = Application.Transpose(Cell.Resize(1, 9).Value2)
        i = 1
'array elements to non-contiguous range
        For Each PrintCell In BasicRange.Cells
            PrintCell.Value = Data(i, 1)
'increment to next array element
            i = i + 1
        Next PrintCell
'print out record
        BasicRange.Parent.PrintOut
    Next Cell
End Sub

Dave

 

[erutherford]

That is impressive!!!! I'm not new to vba, but still very much a novice. There is some code in there that I haven't seen before. Thank you for adding the comments! It really helps me understand what is going on.

Worked right out of the box!

Thanks again

 

[dmt32]

That is impressive!!!! I'm not new to vba, but still very much a novice. There is some code in there that I haven't seen before. Thank you for adding the comments! It really helps me understand what is going on.

Worked right out of the box!

Thanks again

Hi,
many thanks for your kind feedback & glad solution helped. -

solution is nothing original - it just copies each row of data in range to an array which is used to populate your print sheet.
I try to find time comment my code postings to provide OPs with understanding of whats going on. Do also note declaring variables with appropriate data types.
Excel VBA allows you to run code without declaring variables but not considered good practice.

Dave

 

[erutherford]

All entries get the "basic" form printed out for them. Can the code be adapted to select certain groups within the entries?

There are three categories in the "entries" worksheet, Column I. They are "F", "S" and "W". There will be a command button for each group, so we just need to solve one group and I can copy and modify for the others. I started to work with "target value", but not sure if that is correct.

Private Sub CommandButton10_Click() 'Full Print Final
  Dim EntriesRange As Range, FullRange As Range
    Dim PrintCell As Range, Cell As Range
    Dim Data As Variant
    Dim i As Integer
    Dim msg
    
       
            
   msg = MsgBox("Confirm Print all records?", vbYesNo, "Confirm")
        If msg = vbYes Then
    With ThisWorkbook
'basic sheet data entry range
        Set FullRange = .Worksheets("Final_Full").Range("B2,D2,E2,B5,C5,D5,E5,G5")
        With .Worksheets("Entries")
            Set EntriesRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
        End With
    End With
    
    For Each Cell In EntriesRange.Cells
'create array from range
        Data = Application.Transpose(Cell.Resize(1, 9).Value2)
        i = 1
'array elements to non-contiguous range
        For Each PrintCell In FullRange.Cells
            PrintCell.Value = Data(i, 1)
'increment to next array element
            i = i + 1
        Next PrintCell
        
'print out record
      FullRange.Parent.PrintPreview
    Next Cell
    ElseIf msg = vbNo Then

            End If
    Exit Sub
    Worksheets("Final_Full").Range("B2,D2,E2,B5,C5,D5,E5,G5").ClearContents
End Sub

 

[dmt32]

If the code is common to all groups the you can create a single procedure with a parameter for your commandbuttons to pass argument to


try this

Place in standard module

Sub PrintFinal(Optional ByVal Groups As Variant)
   Dim EntriesRange As Range, FullRange As Range
    Dim PrintCell As Range, Cell As Range
    Dim Data As Variant
    Dim i As Integer
    
    With ThisWorkbook
'basic sheet data entry range
        Set FullRange = .Worksheets("Final_Full").Range("B2,D2,E2,B5,C5,D5,E5,G5")
        With .Worksheets("Entries")
            Set EntriesRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
        End With
    End With
    
    For Each Cell In EntriesRange.Cells
'check for selected group
        If IsMissing(Groups) Or UCase(Cell.Offset(, 8).Value) = UCase(Groups) Then
'create array from range
        Data = Application.Transpose(Cell.Resize(1, 9).Value2)
        i = 1
'array elements to non-contiguous range
        For Each PrintCell In FullRange.Cells
            PrintCell.Value = Data(i, 1)
'increment to next array element
            i = i + 1
        Next PrintCell
'print out record
        FullRange.Parent.PrintOut
        End If
    Next Cell
    
End Sub

And from each of your commandbuttons

Private Sub CommandButton10_Click()
    PrintFinal "F"
End Sub

just add the group you want to filter in each button.
Argument can be omitted to print-out all records

Solution untested & should be adjusted to meet specific protect need

Dave

 

[erutherford]

Works fine. How does the command button talk to the module?

Thanks as always.

 

[dmt32]

Works fine. How does the command button talk to the module?

Private Sub CommandButton10_Click()
    PrintFinal "F"
End Sub

The commandbutton click event will, when you press the button, call the PrintFinal procedure where you can pass an argument that is used to filter the required records. Omitting the argument should print all records.

Dave

 

[erutherford]

ok?? The learning curve sometimes seems so sharp, but I'll keep hanging onto the wheel!

Thanks Dave