Message prompt while running the macro

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89
Hi, I have the VBA below which when run asks to input the first business day of the month. Once populated, the macro runs. The problem however is that the pop up window flashes every time for each of the excel files.

I think it would be better to add a one time message box at the beginning of the macro asking '‘Do you want to roll over the month end data?’ with a Yes or No option.

If selected Yes, then the macro will simply run the If statement in BOLD.

If selected No, then the macro should simply skip the if statement and run the else statement in BOLD.

VBA Code:
Sub InProcessRecon()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key As Variant, totals As Long, totals1 As Long, totals2 As Long, fVisRow As Long
    Dim RngList As Object, rng As Range, arr As Variant, i As Long, fNames As String, code As Variant, sDate As String, Day1 As String, prevWS As Worksheet
  
    'Source File Sheet name
    Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
    'Opening In Process files based on the value coming from source file
    fNames = "SIGNAPAY LTD IN PROCESS ACCOUN,In Process DDA Recon - SignaPay," & _
             "EPT 6001 IN PROCESS ACCOUNT,In Process DDA Recon - EPS," & _
             "APS IN PROCESS ACCOUNT,In Process DDA Recon - APS," & _
             "PAYMENT WORLD IN PROCESS ACCT,In Process DDA Recon - Payment World," & _
             "TRISOURCE IN PROCESS ACCOUNT,In Process DDA Recon - TriSource," & _
             "BANCTEK SOLUTIONS IN PROCESS,In Process DDA Recon - BancTek," & _
             "MERCHANT BANCARD IN PROCESS,In Process DDA Recon - MBN," & _
             "ADVANCE MERCHANT IN PROCESS AC,In Process DDA Recon - DAS," & _
             "2C PROCESSOR IN PROCESS,In Process DDA Recon - 2CP," & _
             "FRONTLINE IN PROCESS ACCOUNT,In Process DDA Recon - FrontLine," & _
             "TITANIUM PROCESSING IN PROCESS,In Process DDA Recon - Titanium Processing," & _
             "ARGUS MERCHANT IN PROCESS ACCT,In Process DDA Recon - Argus," & _
             "INFINITY CAPTIAL LLC IN PROCES,In Process DDA Recon - Choice," & _
             "TITANIUM PAYMENTS IN PROCESS,In Process DDA Recon - Titanium Payments," & _
             "MERCHANT INDUSTRY2 IN PROCESS,In Process DDA Recon - Merchant Industry," & _
             "UNIFIED PAYMENTS IN PROCESS,In Process DDA Recon - Unified," & _
             "ELECTRONIC MERCHANT SYS IN PRO,In Process DDA Recon - EMS Conversion," & _
             "MAVERICK IN PROCESS ACCOUNT,In Process DDA Recon - Maverick," & _
             "PIVOTAL PAYMENTS IN PROCESS,In Process DDA Recon - Nuvei," & _
             "C&H FINANCIAL SERVICES IN PROC,In Process DDA Recon - C&H," & _
             "MERCHANT LYNX SERVICES IN PROC,In Process DDA Recon - Merchant Lynx," & _
             "EVANCE IN PROCESS,In Process DDA Recon - eVance," & _
             "TSYS IN PROCESS ACCOUNT,In Process DDA Recon - TSYS," & _
         "BANKCARD IN PROCESS ACCOUNT,In Process DDA Recon - BankCard,GRANITE PAYMENT ALLIANCE IN PR,In Process DDA Recon - Granite,AUTOSCRIBE CORP IN PROCESS,In Process DDA Recon - AUTOSCRIBE,TRX SERVICES IN PROCESS ACCT,In Process DDA Recon - TRX Merchant Services"
           
        arr = Split(Application.Trim(fNames), ",")
      
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(rng.Value) Then
            RngList.Add rng.Value, Nothing
        End If
    Next rng
    For Each key In RngList
        For i = 0 To UBound(arr)
            If arr(i) = key Then
                Set wkbDest = Workbooks.Open(ActiveWorkbook.Path & "\" & arr(i + 1) & ".xlsx")
                With srcWS.Cells(1).CurrentRegion
                    .AutoFilter 1, key
                    fVisRow = srcWS.Range("A1", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
                    sDate = srcWS.Cells(fVisRow, 4)
                    Day1 = Left(Right(sDate, 4), 2)
                  
                    'Roll over data from previous to Current Month when the month rolls over
                 If Day1 = "01" Then
                        If Left(Left(sDate, Len(sDate) - 4) - 1, 1) < 1 Then
                            Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
                        Else
                           Set prevWS = Sheets(Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
                        End If
                        With prevWS
                            Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                            totals = .Range("C:C").Find("Reconciliation Totals").Row
                            totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                            RowCount = totals - 10
                            desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                            .Range("A10:I" & totals - 1).Copy desWS.Cells(totals1, 1)
                        End With
totals1:
                        Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                        totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        RowCount = srcWS.[subtotal(103,A:A)] - 1
                        desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                        srcWS.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 2)
                        totals2 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        For Each rng In desWS.Range("B" & totals1 & ":B" & totals2 - 1)
                            rng = Format(DateSerial(Right(rng, 2), Left(rng, Len(rng) - 4), Mid(rng, Len(rng) - 3, 2)), "mm/dd/yy")
                        Next rng
                        With srcWS
                            .Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 5)
                            .Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 6)
                            .Range("G2:G" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 3)
                            .Range("H2:H" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 4)
                        End With
                        srcWS.Cells(1).AutoFilter
                        totals2 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        With desWS.Range("B10:B" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("C10:C" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("D10:D" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("E10:E" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlCenter
                            .Replace "55", "DR"
                            .Replace "78", "DR"
                            .Replace "18", "CR"
                            .Replace "38", "CR"
                        End With
                        With desWS.Range("F10:F" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                        End With
                        With desWS
                            For Each code In .Range("E10:E" & totals2 - 1)
                                If code = "DR" Then
                                    If code.Offset(, 1) > 0 Then
                                        code.Offset(, 1) = "-" & code.Offset(, 1)
                                    End If
                                    code.Offset(, 1).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                                ElseIf code = "CR" Then
                                    code.Offset(, 1).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                                End If
                            Next code
                        End With
                        With desWS
                            .Range("G10:I10").Copy
                            .Range("G10:I" & totals2 - 1).PasteSpecial Paste:=xlPasteFormulas
                            .Range("F" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""F10:F""&ROW()-1))"
                            .Range("G" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""G10:G""&ROW()-1))"
                            .Range("H" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))"
                        End With
                    Else
                        GoTo totals1
                    End If
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    MsgBox ("In Process recon job completed successfully.  Please check the Files.")
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Basically the logic should be based on if the user will select Yes or No.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89
Sorry here's the If Statement If you're unable to locate in the above VBA. I'd like the message prompt right above this logic.

VBA Code:
  'Roll over data from previous to Current Month when the month rolls over
                 If Day1 = "01" Then
                        If Left(Left(sDate, Len(sDate) - 4) - 1, 1) < 1 Then
                            Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
                        Else
                           Set prevWS = Sheets(Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
 

CKinTX

New Member
Joined
Jan 21, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Try a Yes/No Message box;

'------------------------------------
Dim answer As Integer

answer = MsgBox("Text", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")

If answer = vbYes Then
'put code here
Else
'put code here
End If
'------------------------------------
 

horizonflame

Board Regular
Joined
Sep 27, 2018
Messages
184
Office Version
  1. 2013
Above your If statement you could put a simple OK/Cancel message box...

VBA Code:
MsgBox "Would you like to continue?", vbOKCancel

At the end of your code if needed:

VBA Code:
MsgBox "Complete"
 

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89

ADVERTISEMENT

It works. Thank you both :)
 

CKinTX

New Member
Joined
Jan 21, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
No problem-o.
Herb Tarlek.png
 

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89
VBA Code:
Set RngList = CreateObject("Scripting.Dictionary")
    For Each rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(rng.Value) Then
            RngList.Add rng.Value, Nothing
        End If
    Next rng
    For Each key In RngList
        For i = 0 To UBound(arr)
            If arr(i) = key Then

Hi - In the above code, There is a scripting dictionary object created which compares and matches the file names and runs the code only for those files that are found in the source file.

What I'd ideally like to happen is when the vbanswer is Yes, open all files that have been included under fnames and run the code.
Only when the vbanswer is No, it can use the above logic.

Thank you
 

Watch MrExcel Video

Forum statistics

Threads
1,129,489
Messages
5,636,626
Members
416,932
Latest member
mm07

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