VBA Compare Cell Value Between and Then Print a sheet

[sxhall]

Hi,

Thanks for looking.

Have been puzzling over this for an hour now but cannot piece in the missing part to the below.

All I want to do is...

- Define a range starting in cell A3
- Compare the value in column A with cell Q2, greater than or equal to and compare to cell S2 less than or equal to
- If it meets the criteria then take the cell value and paste it to cell U2 to then print out another sheet which will reference this value

Code I have so far is...

Sub PrintDriverReturns()

Dim lRow As Long

With ActiveSheet

    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    
End With


For Each i In Range("A3:A" & lRow)

    If Cells(i, "A").Value <= Range("Q2").Value And Cells(i, "A").Value >= Range("S2").Value Then
        
        Cells(i + 2, "A").Select
        Cells(i + 2, "A").Copy
        Range("U2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Worksheets("Forms - Driver Returns").Select
        
        ActiveSheet.PrintPreview
        
        Worksheets("Found in Driver Returns").Select
        
    Else
    
    End If
    
Next

End Sub

Thanks in advance for any assistance

Steven

PS values will always be numeric starting at 1

 

[Fluff]

Give this a go.

Sub PrintDriverReturns()

    Dim lRow As Long
    Dim Cl As Range
    
    With ActiveSheet
        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        
        For Each i In .Range("A3:A" & lRow)
        
            If Cl.Value <= .Range("Q2").Value And Cl.Value >= .Range("S2").Value Then
                .Range("U2").Value = Cl.Value
                Worksheets("Forms - Driver Returns").Select
                ActiveSheet.PrintPreview
            End If
        Next
    End With

End Sub

From your description, I think the <= & >= might be the wrong way round, but went with your code.

 

[sxhall]

Thanks Fluff,

Picked up on my signs being the wrong way round.

Give this a go.

Sub PrintDriverReturns()

    Dim lRow As Long
    Dim Cl As Range
    
    With ActiveSheet
        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        
        For Each i In .Range("A3:A" & lRow)
        
            If Cl.Value <= .Range("Q2").Value And Cl.Value >= .Range("S2").Value Then
                .Range("U2").Value = Cl.Value
                Worksheets("Forms - Driver Returns").Select
                ActiveSheet.PrintPreview
            End If
        Next
    End With

End Sub

From your description, I think the <= & >= might be the wrong way round, but went with your code.

I went with the following as I had a few other issues my original code that I found.

Sub PrintDriverReturns()

Dim lRow As Long
Dim SRange As Range
Dim cell As Range

Application.ScreenUpdating = False

Sheets("Forms - Driver Returns").Visible = True

If Range("Q2") = "" Or Range("S2") = "" Then
    
    Range("U2").Select
        ActiveCell.FormulaR1C1 = "=SUM(RC[-4]+RC[-2])"
    Worksheets("Forms - Driver Returns").Select
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    'ActiveSheet.PrintPreview
    
    Worksheets("Found in Driver Returns").Select

Else

    With ActiveSheet
    
        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        
    End With
    
    Range("A3:A" & lRow).Select
    Set SRange = Selection
    
    For Each cell In SRange
    
        If cell.Value >= Range("Q2").Value And cell.Value <= Range("S2").Value Then
            
            cell.Select
            cell.Copy
            Range("U2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Worksheets("Forms - Driver Returns").Select
            
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
            'ActiveSheet.PrintPreview
            
            Worksheets("Found in Driver Returns").Select
            
        Else
            
        End If
        
    Next cell

End If

Sheets("Forms - Driver Returns").Visible = False

    Range("U2").Select
    Selection.ClearContents
    Range("Q2").Select

With Application

    .CommandBars("Format Object").Visible = False
    .ScreenUpdating = True
    
End With

End Sub

I will update this now as well based on your code to replace my copy and paste steps.

Thnaks for coming back to me

Steven.

 

[Fluff]

Glad to help.