Applying a message box to each row if there are more than 1

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have got a spreadsheet that has an autofilter that filters jobs based on date and request number. If there are more than 1 result, I want the spreadsheet to zoom in and highlight the first result/row and ask if this is the job that needs to have the Late Cancel pricing, applied to it, if No is pressed, move on to the next job that matches the criteria. There will only be one job that matches the criteria and if no is pressed for each job, display a message box 'no jobs have been cancelled'.

My procedure works when there is just one match, but if there are multiple, I want it to ask for each one.

I do not know how to code very well and this is what I have managed to scrounge around from various places.

VBA Code:
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    For Each x In rng
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                    Next x
                                'End If
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I was thinking I could use it as the visible, filtered rows or filtered jobs. If there are 2 jobs for instance with the same request number and date, the 2 jobs will be filtered using the autofilter and these jobs could be rng. I then wanted to ask if each separate job is the one to have the late cancel pricing applied to it.
 

aRandomHelper

Board Regular
Joined
Jan 14, 2021
Messages
235
Office Version
  1. 2016
Platform
  1. Windows
What I meant was, do you have a line 'Set rng = ....' above that segment of code you posted? Since you're looping that range with For Each, there's quite a huge difference between that rng containing multiple columns of data vs only one column.

I want the spreadsheet to zoom in and highlight the first result/row
ask if this is the job
if No is pressed, move on to the next job
I assume these are the things you want the loop to do, so I assume you also know what to do when 'Yes' is pressed as well?
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

I am still becoming familiar with vba code so I don't think there is a set rng above it. I can't check at the moment.

I have code that runs for a single row so I mainly needed help with how to specify the row. The described actions are what I want to carry out.

I also needed help with the code specifythe filtered range that I use the above for each loop on.

As I am not very good at vba, I really appreciate this help!
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

I can get my code when I get to work tomorrow.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I just remembered, the rest of the sub is the code that is to run on the single line of code,once it has been found.

The bits in my first post were the only bits relating to the issue I have described. I knew there were bits missing from it but that is all I had written on what I am trying to do.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Here is the code for the entire procedure.

VBA Code:
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
                                
                                'if this range is greater than 1, ask the below question, else continue

                                



                                
                                
                                      




                                        
                                    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
                                    
                                    
                                    '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(1, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
                                    .Areas(1).Cells(1, 8).Value = LCPrice
                                    .Areas(1).Cells(1, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                    .Areas(1).Cells(1, 10).Formula = "=RC[-1]+RC[-2]"
                                End With
                                
                              
                                .AutoFilter
                        End With
                End If

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


Here is the code I tried to write but I wasn't sure where to put it. I was trying to write the code if there are multiple instances of the same date and request number, to zoom in on each one, maybe highlight the row and ask if this row is the correct row to have the LateCancel pricing applied to it.

VBA Code:
                                'Dim rng As Range: rng = ws.Range("A4:" & ws.Range("A4").End(xlUp))
                                Dim rng As Range: rng = ws.range(("A4:"), ("O"&("A4").End(xlUp).Row)) 'column o is 15
                                Dim x
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    For Each x In rng
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                    Next x
                                End If

That was the aim but I only got it partly done.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,148
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I almost think that the last window of code almost needs to go in a separate procedure.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,768
Messages
5,626,758
Members
416,202
Latest member
donya ba

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top