If No is pressed for each row, the values are pasted over the header

[dpaton05]

I have a range where I ask a question, is this the correct row. If I press Yes, the code pastes in values for that row.

The problem is that if there are 4 rows and I press No 4 times, the values are pasted in over the header. How do I get it to not do that and maybe display a message box instead?


I think this is the relevant bit of code that it is relating too

                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                              
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                      
                                    Next RowLine
                                End If

This is my whole sub if you need it

Sub LateCancel()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, QT As String, wb2 As Workbook, WbPath As String, QTPath As String
        Dim Serv As String, Month As String, Service As String, LCPrice As String, AutoFilterCounter As Long
        Set wb2 = ThisWorkbook
        'QT = "CSS_quoting_tool_29.5.xlsm"
        Set sh = wb2.Worksheets("Totals")

        'values on totals sheet that the user is looking for
        Dim LCReq As String: LCReq = sh.Cells(32, 2).Value
        'Dim LCDt As String: LCDt = sh.Cells(37, 2).Value
        Dim LCDt As String: LCDt = CDate(sh.Cells(37, 2).Value)
        Dim LateCancelHours As String: LateCancelHours = sh.Cells(35, 2).Value
        Dim SheetCounter As Long: SheetCounter = 0
      
        WbPath = ThisWorkbook.Path
        QTPath = ThisWorkbook.Path & "\..\" & "\..\"
Call TurnOffFunctionality
        'If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        'If Not isFileOpen(QT) Then Workbooks.Open QTPath & "\" & QT
  
        For Each ws In wb2.Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                'On Error Resume Next
                                'Autofilter the late cancel date enter in B37 with dates in column 1
                                .AutoFilter 1, LCDt
                                'Autofilter the late cancel request number with request numbers in column 3
                                .AutoFilter 3, LCReq
                              
                                'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                If ws.[A3].Cells.Offset(1, 0) = "" Then
                                    .AutoFilter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                              
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                              
                                    With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                        'Check if there is a service entered in column 5 of the filtered job.
                                        If .Areas(1).Cells(1, 5).Value = "" Then
                                            'Display a messagebox with a message and the sheet that has the missing service.
                                            MsgBox "There is a job in the " & ws.Name & " sheet that matches the date and request number but does not have a " & _
                                            "service type. Please add a service type to this job before continuing."
                                            Call TurnOnFunctionality
                                            .AutoFilter
                                            'Cells(32, 2).ClearContents
                                            'Cells(37, 2).ClearContents
                                            Exit Sub
                                        End If
                                        'If the service column, (5), has a value, store the service in the service variable.
                                        Service = .Areas(1).Cells(1, 5).Value
                                    End With
                              
                              
                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                              
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                      
                                    Next RowLine
                                End If
FoundRightJob:
                                  
                                    'Copy data fom the job back to a calculator on the data sheet (this is the code name for sheet2) to calulcate the price again.
                                    With Data
                                        .Cells(30, 1) = CDate(LCDt)
                                        '.Cells(30, 1) = Format(Date, "d/mm/yyyy")
                                        '.Cells(30, 1).NumberFormat = "d/mm/yyyy"
                                        .Cells(30, 2) = Service
                                        'Set the hourly figure in the lateCanel table to be the LateCancelHours variable
                                        .Cells(30, 5) = LateCancelHours
                                        'A late cancel will be charged for 1 staff member attending
                                        'Therefore, set the Staff Req. figure to 1
                                        .Cells(30, 6) = 1
                                    End With
                                    On Error GoTo Price
                                        'Calculates price of late cancel on worksheet so the new price will be copied to the allocation sheet instead of the previous price
                                        Calculate
                                    LCPrice = Data.Cells(30, 8).Value
Price:
                                Select Case Err.Number
                                    Case Is = 13
                                        MsgBox "There is a problem with the spelling of the service type on the " & ws.Name & " sheet for the job that matches " _
                                        & "the date and request number. Please check the spelling and try again."
                                        'Cells(32, 2).ClearContents
                                        'Cells(37, 2).ClearContents
                                        .AutoFilter
                                        Call TurnOnFunctionality
                                        Exit Sub
                                End Select
                                On Error GoTo 0
                                With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                    Dim LTCnclDate As String
                                    .Areas(1).Cells(RowNumber, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
                                    .Areas(1).Cells(RowNumber, 8).Value = LCPrice
                                    .Areas(1).Cells(RowNumber, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                    .Areas(1).Cells(RowNumber, 10).Formula = "=RC[-1]+RC[-2]"
                                End With
                              
                            
                                .AutoFilter
                        End With
                End If

SkipNextSheet:
        Next ws
'sh.Range("B32,B37").ClearContents
Call TurnOnFunctionality

End Sub

Thanks

 

[offthelip]

what do you want to happen when you say NO to every line?
you could try something like this :

FoundRightJob:
 if rownumber < 1 then 
  Msgbox(" You haven't selected a row so processed abandoned"
 exit sub
 end if

 

[dpaton05]

Just display a message box saying, no rows have been selected.

 

[dpaton05]

Thanks for that

 

[dpaton05]

This is my sub

                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                                
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                        
                                    Next RowLine
                                End If
FoundRightJob:
                                'No has been selected each time so display a message box and exit sub
                                If RowNumber < 1 Then
                                    MsgBox "No jobs have been selected as a Late Cancel"
                                    .AutoFilter
                                    Exit Sub
                                End If

I cannot see how it works, how if the RowNumber <1 then display the message box. Could someone explain that to me please?

 

[offthelip]

The logic is: you define a variable " rownumber" and don't set it to anything so it will default to zero, you then loop through all the lines and you only set rownumber if you answer yes., If you answer no to all lines then rownumber remains at zero, so a test for rownumber less than 1 will catch the event when all rows are answered no. I always try to test for a number being less than or greater than some rather than equal to something ( e.g zero) because excel can sometimes fail when trying to compare two numbers as being equal.

 

[dpaton05]

Thanks