Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key As Variant, 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
Set srcWS = ThisWorkbook.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"
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(ThisWorkbook.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)
Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
If desWS.Range("D1") <> Date Then
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("B12:B" & totals2 - 1)
.Font.Name = "Bookman Old Style"
.Font.Color = 10040115
.Font.Size = 10
.HorizontalAlignment = xlLeft
End With
With desWS.Range("C12:C" & totals2 - 1)
.Font.Name = "Bookman Old Style"
.Font.Size = 10
.HorizontalAlignment = xlLeft
End With
With desWS.Range("D12:D" & totals2 - 1)
.Font.Name = "Bookman Old Style"
.Font.Color = 10040115
.Font.Size = 10
.HorizontalAlignment = xlLeft
End With
With desWS.Range("E12: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("F12:F" & totals2 - 1)
.Font.Name = "Bookman Old Style"
.Font.Color = 10040115
.Font.Size = 10
End With
With desWS
For Each code In .Range("E12: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(""F12:F""&ROW()-1))"
.Range("G" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""G12:G""&ROW()-1))"
.Range("H" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H12:H""&ROW()-1))"
.Range("I" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""I12:I""&ROW()-1))"
End With
desWS.Range("D1") = Date
Else
srcWS.Cells(1).AutoFilter
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
