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.
Basically the logic should be based on if the user will select Yes or No.
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 SubBasically the logic should be based on if the user will select Yes or No.
