Change the range the same as the print X to Y input

[slayer1957]

Good day,

I have code below, when I run the macro it ask me with inputboxes X and Y from which row to which row it must populate a checklist and then print each one. The one piece of code i do not know how to change.

I want it to check the row X to Y and check the same range for each row as the StatusRow, so if it is X=1 it must check in Range ("K3:Z3"), if X=100 it must check Range ("K103:Z103"), it must just accumulate till it reached the value of Y.

So it must only be defined to check range every time X increases by 1 more for each loop till it reaches Y

The Set StatusRow = Sheet14.Range("K3:Z3") must change as X increases to Y.

Another portion is for the Sheet14 to be selected via a selection/combo box, it must not always be sheet 14, i want to select from dropdown the worksheet name and then the code execute on that sheets range as above.

Public Sub CustomPrintFULL()
'------------------------------------------------------------
    
    Dim StatusRow As Range
    Dim Status As Range
    Dim PasteCell As Long
    Set StatusRow = Sheet14.Range("K3:Z3")
    
'Application.EnableEvents = False
'------------------------------------------------------------
Dim lPrint As Long
'------------------------------------------------------------
'START ROW SELECTION TO PRINT
Dim UserInput1 As String, X
UserInput1 = InputBox("Please enter START rows that you would like to print")
If UserInput1 = "" Then Exit Sub
X = UserInput1

'END ROW SELECTION TO PRINT
Dim UserInput2 As String, Y
UserInput2 = InputBox("Please enter END rows that you would like to print")
If UserInput2 = "" Then Exit Sub
Y = UserInput2
'------------------------------------------------------------
  For lPrint = X To Y
 
    PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Finds the lastrow and use next blankrow
    
'Define each status for each column, starting from L-1-14 columns, the colums should be numbered if the equipment is present it should have the cell number inside
    For Each Status In StatusRow
'-------------------------------------
        'Status L in column "List"
        If Status = "L" Then
            Sheet4.Range("A1:H8").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------


  [A4] = Sheet14.[$I2].Offset(lPrint - 0, 0)    'Equipment -    '{A3} is the cell value to change every time on the ActiveSheet, Set the cell value to change in [__]
                                                                'Range from Sheet number, cell range in second [__], Offset is the starting row and column
  [A5] = Sheet14.[$J2].Offset(lPrint - 0, 0)    'Description
 
  [B5] = Sheet14.[$D2].Offset(lPrint - 0, 0)    'Cubicle
 
  [E5] = Sheet14.[$G2].Offset(lPrint - 0, 0)    'Board
 
  Range("A6").Select
    Selection.Formula = "=K5"   'Inspection date
 
  Range("A7").Select
    Selection.Formula = "=K6"   'Description, shutdown inspection

'-------------------------------------
        'Status 1 in column "Stubs"
        If Status = "1" Then
            Sheet4.Range("A9:H16").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 2 in column "Isolator"
        If Status = "2" Then
            Sheet4.Range("A18:H31").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 3 in column "Fuse Holder"
        If Status = "3" Then
            Sheet4.Range("A33:H38").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 4 in column "Contactor"
        If Status = "4" Then
            Sheet4.Range("A40:H60").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 5 in column "Overload"
        If Status = "5" Then
            Sheet4.Range("A62:H74").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 6 in column "Terminal Slide-In Contacts/Terminal Block"
        If Status = "6" Then
            Sheet4.Range("A76:H83").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 7 in column "Slide in contacts"
        If Status = "7" Then
            Sheet4.Range("A85:H89").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 8 in column "Control circuit breaker/Control Fuse"
        If Status = "8" Then
            Sheet4.Range("A91:H94").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 9 in column "Control Transformer"
        If Status = "9" Then
            Sheet4.Range("A96:H101").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 10 in column "Lamp Indication"
        If Status = "10" Then
            Sheet4.Range("A103:H106").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 11 in column "Timers"
        If Status = "11" Then
            Sheet4.Range("A108:H112").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 12 in column "Slave relays"
        If Status = "12" Then
            Sheet4.Range("A114:H116").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 13 in column "Speed relays/Conveyor"
        If Status = "13" Then
            Sheet4.Range("A118:H122").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 14 in column "MCC"
        If Status = "14" Then
            Sheet4.Range("A124:H140").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If
'-------------------------------------
        'Status 15 in column "Sign off"
        If Status = "S" Then
            Sheet4.Range("A141:H158").Offset(0, 0).Copy Sheets("TEST").Range("A" & PasteCell) 'Paste to blankrow on "TEST" sheet
            PasteCell = Sheets("TEST").Cells(Rows.Count, "H").End(xlUp).Row + 1  'Find the next blankrow again
        End If


    Next Status
'-------------------------------------
'***************************************************************************************************************************
  Dim LastRow As Long
   LastRow = Range("A:H").SpecialCells(xlCellTypeLastCell).Row
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & LastRow
    
'***************************************************************************************************************************
    
    'Dim LastRow As Long
    'With ActiveSheet
    '    LastRow = .Cells(.Rows.Count, "H").SpecialCells(xlCellTypeLastCell).End(xlUp).Row
    '    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & LastRow
    '    ActiveSheet.PageSetup.PrintArea = Range(Cells(LastRow)).Address
    'End With
 
 '***************************************************************************************************************************
 '   With ActiveSheet.PageSetup
        '.PrintTitleRows = "$1:$2"
        '.Orientation = xlLandscape
        '.FirstPageNumber = xlAutomatic
        '.FitToPagesWide = 1
        '.FitToPagesTall = 1
 '   End With
'***************************************************************************************************************************
'Dim LastRow As Long
'Dim ws As Worksheet
'LastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    'get the last row with data on Column H
'    ws.PageSetup.PrintArea = "A1:H" & LastRow
    'set print area from A1 to last row on column H
    
'***************************************************************************************************************************
' Dim sh As Worksheet
'    Dim LstRw As Long, Rng As Range
'        With sh
''            LstRw = .Cells(.Rows.Count, "H").End(xlUp).Row
 '           Set Rng = .Range("A1:H" & LstRw)
'            .PageSetup.PrintArea = Rng.Address
'        End With
'***************************************************************************************************************************
'Dim LR As Long
'With ActiveSheet
'    LR = .Range("H" & Rows.Count).End(xlUp).Row
'    .PageSetup.PrintArea = "A1:H" & LR
'    End With
'***************************************************************************************************************************

'-------------------------------------
  ActiveSheet.PrintOut
  'ActiveSheet.PrintOut Preview:=True
 
 

Application.Wait (Now + TimeValue("00:00:20"))
'-------------------------------------
'-------------------------------------
'-------------------------------------
'Call ClearTestPage


  Next lPrint
'Application.EnableEvents = True

End Sub