CODEWITHSUNDEEP
excelvba
Curtis
Curtis

Reputation: 45

Number each Row when printing VBA

I'm finding the matches in two columns (myrange1 & myrange2), filling them in a third column ("R") of sheet2. I have my Range from column "R" printing out to a PDF just fine, but I want each one to be numbered sequentially on the PDF i.e. 1,2,3,4 etc. Help much appreciated. Pretty new to VBA as well. 

Sub matchcopy()
    Dim myrange1 As Range, myrange2 As Range, cell As Range

    With Sheets("Sheet1")
        Set myrange1 = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With

    With Sheets("Sheet2")
        Set myrange2 = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With

    For Each cell In myrange1
        If Not IsError(Application.Match(cell.Value, myrange2, 0)) Then  
            'cell.Value, myrange2, 0
            cell.Copy
            Sheet2.Range("R5000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        Else
            'MsgBox "no match is found in range"
        End If
    Next cell

    Columns("R:R").EntireColumn.AutoFit
    Call Set_PrintRnag
End Sub


Sub Set_PrintRnag()
    Dim LstRw As Long
    Dim Rng As Range

    LstRw = Cells(Rows.Count, "R").End(xlUp).Row
    Set Rng = Range("R1:R" & LstRw)

    With ActiveSheet.PageSetup
        .LeftHeader = "&C &B &20 Cohort List Report : " & Format(Date, 
    "mm/dd/yyyy")
    End With

    Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & _
      "\CohortList " & " " & Format(Date, "mm-dd-yyyy") & ".pdf", _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Upvotes: 1

Views: 563

Answers (2)

T.M.
T.M.

Reputation: 9948

As close as possible to your code, though looping through a range is always time consuming and you would be faster working with arrays of the columns to be compared:

Option Explicit

Sub matchcopy()
    Dim i&
    Dim myrange1 As Range, myrange2 As Range, cell As Range
  ' You can use the Codenames instead of Worksheet("Sheet1") etc.
    Set myrange1 = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
    Set myrange2 = Sheet2.Range("A1", Sheet2.Range("A" & Rows.Count).End(xlUp))
    Sheet2.Range("R:S") = ""                 ' <~~ clear result columns

    For Each cell In myrange1               ' presumably unique items
        If Not IsError(Application.Match(cell.Value, myrange2, 0)) Then
            cell.Copy
            With Sheet2.Range("R5000").End(xlUp)
                i = i + 1                   ' <~~ counter
                .Offset(1, 0) = i           ' counter i equals .Row - 1
                .Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
            End With
        Else
            'MsgBox "no match is found in range"
        End If
    Next cell

    Sheet2.Columns("R:S").EntireColumn.AutoFit
    Call Set_PrintRnag                      ' called procedure see OP
End Sub

Sub Set_PrintRnag()
Dim LstRw As Long
Dim Rng As Range

LstRw = Sheet2.Cells(Rows.Count, "R").End(xlUp).Row
Set Rng = Sheet2.Range("R1:S" & LstRw)

With Sheet2.PageSetup
    .LeftHeader = "&C &B &20 Cohort List Report : " & Format(Date, "mm/dd/yyyy")
End With

Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & _
  "\CohortList " & " " & Format(Date, "mm-dd-yyyy") & ".pdf", _
  Quality:=xlQualityStandard, IncludeDocProperties:=True, _
  IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Additional hint

To get some ideas how to use a datafield array, see e.g. SO answer to Loop with multiple ranges

Upvotes: 2

Michael Esposito
Michael Esposito

Reputation: 21

Do you need a VBA script to accomplish your desired goal? If you are just trying to compare two values and output the result in your Column R, you should be able to do it with an IF function: https://support.office.com/en-us/article/if-function-69aed7c9-4e8a-4755-a9bc-aa8bbff73be2

If you want sequential numbering for results, I'd suggest having the number in an adjacent column and exploring the COUNTA function: https://support.office.com/en-us/article/counta-function-7dc98875-d5c1-46f1-9a82-53f3219e2509

And if you do require this in VBA scripting format, you can do it with an Excel function first and record a macro afterwards. Makes creating the actual VBA syntax a little easier! https://support.office.com/en-us/article/automate-tasks-with-the-macro-recorder-974ef220-f716-4e01-b015-3ea70e64937b

Upvotes: 2

Related Questions