CODEWITHSUNDEEP
excelvba
HeavyLoad Collection
HeavyLoad Collection

Reputation: 67

How to Paste Data in Columns and Rows in this way

i have some label data to print in columns and rows format based on the user defined input Value. their are 3 main inputs based conditions:

1) No of starting label to skip 2) No of label per Row 3) No of Rows Per page

I have one data sheet which has data in column A and No of copies to be printed in column B. i am attaching examples images with different input and output in page i expect to be printed. Also giving link to code which could be relevant for my purpose.

Data Sheet

enter image description here

Print Sheet

enter image description here

My codes are limited to 3 columns with unlimited rows and without skip

Here Can you tweak these codes for Userform : Make it small and efficient are codes for dynamic userfrom textbox creation given by @Brian M Stafford but not sure how to implement for this purpose

Public Sub GenerateLabels()
Dim CopyRowValue As String
Dim SecondDataCol, ThirdDataCol, FirstDataCol As Long
Dim SecondDataRow, ThirdDataRow, FirstDataRow As Long

Set shdata = ThisWorkbook.Sheets("Database")
Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")

FirstDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column
SecondDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column
ThirdDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column

FirstDataRow = shgenerate.Cells(shgenerate.Rows.Count, "A").End(xlUp).Row
SecondDataRow = shgenerate.Cells(shgenerate.Rows.Count, "C").End(xlUp).Row
ThirdDataRow = shgenerate.Cells(shgenerate.Rows.Count, "E").End(xlUp).Row

'======== Copy From Data Sheet============

Last_Row = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row

For r = 2 To Last_Row  

shdata.Cells(x, "A").Copy
shDesignFormat.Range("B3").Paste 'pasting data to design sheet before print (to format data)

CopyRowValue = Worksheets("Database").Cells(r, "B").value 

For r2 = 1 To CopyRowValue 

'=====Paste to Generate Sheet ====

'Cells(FirstDataRow + 1, FirstDataCol + 1).Offset(0, 0).Select
If IsEmpty(shgenerate.Cells(FirstDataRow + 0, FirstDataCol + 0).Offset(0, 0).value) = True Then

shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(FirstDataRow + 0, FirstDataCol + 0).Offset(0, 0)

ElseIf IsEmpty(shgenerate.Cells(SecondDataRow + 0, SecondDataCol + 2).Offset(0, 0).value) = True Then 'offset used to find empty cell if design layout changed
shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(SecondDataRow + 0, SecondDataCol + 2).Offset(0, 0)

ElseIf IsEmpty(shgenerate.Cells(ThirdDataRow + 0, ThirdDataCol + 4).Offset(0, 0).value) = True Then
shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(ThirdDataRow + 0, ThirdDataCol + 4).Offset(0, 0)


SecondDataRow = SecondDataRow + 2
ThirdDataRow = ThirdDataRow + 2
FirstDataRow = FirstDataRow + 2

End If

Next r2

Next r

Application.CutCopyMode = False

End Sub

Upvotes: 0

Views: 131

Answers (1)

Brian M Stafford
Brian M Stafford

Reputation: 8868

Looking at your code, my first thought was it could be simplified. Once I did this, I began modifying to add needed requirements. The main task was keeping track of the current location. The code ended up like this:

Option Explicit

Public Sub GenerateLabels(ByVal LabelsToSkip As Integer, ByVal LabelsPerRow As Integer, ByVal RowsPerPage As Integer)
   Dim shdata As Worksheet
   Dim shgenerate As Worksheet
   Dim shDesignFormat As Worksheet
   Dim curRow As Long
   Dim curCol As Long
   Dim RowsPerPageCount As Long
   Dim r As Long
   Dim r2 As Long

   Set shdata = ThisWorkbook.Sheets("Database")
   Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
   Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")

   shgenerate.UsedRange.ClearContents

   curRow = 1
   curCol = 1
   RowsPerPageCount = 1

   For r = 2 To shdata.Range("A" & Rows.Count).End(xlUp).Row
      '======== Copy From Data Sheet============
      shdata.Cells(r, "A").Copy
      shDesignFormat.Range("B3").PasteSpecial  'pasting data to design sheet before print (to format data)

      For r2 = 1 To shdata.Cells(r, "B").Value + LabelsToSkip
         '=====Paste to Generate Sheet ====
         If curCol > LabelsPerRow * 2 Then  '* 2 for double spacing
            curCol = 1

            If RowsPerPage > 0 And (RowsPerPageCount + 1) Mod (RowsPerPage + 1) = 0 Then
               curRow = curRow + 10  'new page
               RowsPerPageCount = 1
            Else
               curRow = curRow + 2
               RowsPerPageCount = RowsPerPageCount + 1
            End If
         End If

         If r2 > LabelsToSkip Then
            LabelsToSkip = 0
            shDesignFormat.Range("B3").Copy Destination:=shgenerate.Cells(curRow, curCol)
         End If

         curCol = curCol + 2
      Next r2
   Next r

   Application.CutCopyMode = False
End Sub

I recommend using Option Explicit and declaring all variables that you need.

Upvotes: 1

Related Questions