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
Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
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 INDUSTR 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,TSYS IN PROCESS ACCOUNT,In Process DDA Recon - TSYS"
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 = InputBox("Enter the date of the first business day of the month in the format 'mmddyy', for example '010220'.")
Day1 = Left(Right(sDate, 4), 2)
If Day1 = "01" Then
Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
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("G12:I12").Copy
.Range("G13: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))"
.Range("I" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))+SUM(INDIRECT(""G10:G""&ROW()-1))"
End With
Else
GoTo totals1
End If
End With
End If
Next i
'wkbDest.Close True
Application.Wait (Now + TimeValue("00:00:05"))
Next key
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
