Copy from one source file into multiple excel files - All live in one location

B

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
93
Hello ,

I have an excel file which is the source document and I have other excel files which are destination files all in one location.

- I want VBA to open the source excel and Format the Date in Column C of the source to MM YYYY.
- Check if column A has the word 'SIGNAPAY' ,
- If true then open a document called 'In process SIGNAPAY.xlsx' from that location,
- Click on the sheet name which matches with Column C (MM YYYY) of the source excel.
- Copy rows through columns A:G in the source excel for all rows which have SIGNAPAY in column A and paste into the last empty rows in the 'In Process SIGNAPAY.xlsx' workbook.

Below is what the data would look like:



[TABLE="class: cms_table_cms_table_cms_table, width: 1031"]
<tbody>[TR]
[TD]DMTITL[/TD]
[TD]DHACCT[/TD]
[TD]DHDATE[/TD]
[TD]DHDATC[/TD]
[TD]DHITC[/TD]
[TD]DHAMT[/TD]
[TD]DESC1[/TD]
[TD]DESC2[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]259[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]499[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]2795.81[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]6000[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]6500[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019190[/TD]
[TD="align: right"]70919[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]114[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]834.47[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]1590.7[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]2609.02[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]3294.32[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]4632.49[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]6667.57[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
</tbody>[/TABLE]

 
Sort by date Sort by votes
Hello,

I have posted a new thread and was able to rectify the error.

But there is a new request in the process which they noticed today while running.

Whenever the source file has 1st of the new month's date in column D, for example if its 10/01/2019, they not only want to copy paste rows from source to destination in the new month's tab but also rollover previous months data into the new month.

For example,

current process:

Today they got the source file data for 10/01/19
run macro
Paste's rows from source into 1019 tab of the destination file.

What they requested:
Today they got the source file data for 10/01/19
run macro
Paste rows from previous month's tab (0919) over to the current month's tab (1019) first and then copy rows from source to destination.
This process should run only if the source file has the date as 1st of the month in the column D. The process remains as the current process for the rest of the days.

I hope I was clear.

Thank you
 
Upvote 0

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Do you want the previous month's data to go below any already existing data in the destination sheet? Does the first of the month date appear in the first row for each account? Is it possible that some accounts may not have a first of the month date? It might help if you could upload a copy of the source file which includes first of the month dates. Please ensure that the data is representative of any possible date situations. Also, since you got a solution for the personal xlsb problem, I would assume that my macro had to be modified. If this is the case, could you please include the modified macro.
 
Upvote 0
Hello,

Here's the link to the files: https://esquirebank.box.com/s/qcvjdzlqgrw2aux05wrc1i3v1z8d44hm

Please see source file has 4 rows for 10012019.
Previously what it would do was copy this 4 rows into the Signapay file in the 1019 tab.

But what they want is the previous month's tab 0919 data to also be copied from 0919 to 1019.

Please see tabs 0919 and 1019 of the destination file that I uploaded. I think it will be clear.


This should happen only if the source file date in column D is the 1st of the month. like 100119,110119,120119 etc..


Here is the updated macro below. I have highlighted what's changed in red.

Code: 
Sub InProcessRecon()
    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 = [COLOR=#ff0000]Sheets[/COLOR]("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([COLOR=#ff0000]ActiveWorkbook[/COLOR].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"))
                    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))"
                    End With
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi, I keep getting the Runtime error 91 "object or with variable not set" on the code line 'wkbDest.Close True'I have a feeling the program is trying to open and close excel very quickly and running into issues. Can we please add some wait time in between open, pasting and closing?

Thank you
 
Upvote 0
When I try the link you posted, it asks me to sign in to my account. Can you please upload to a site where I can download the files directly without having to sign in?
 
Upvote 0
In the latest version of your destination file, the data starts at row 10. In the previous versions, the data started at row 12. The following macro is based on the data in all the destination files starting at row 10.
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
    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 = srcWS.Cells(fVisRow, 4)
                    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
    Next key
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
That is correct. All the files have been adjusted to start at Row 10 which I modified in the macro but sorry didn't tell you.

I tested and it looks good. The only question I have is to make sure there is some type of timing added in between opening, copy paste and closing the excel worksheets.

Sometimes due to network issues, opening and closing excel quickly results in error on our end.

I'm okay if the process takes a minute or two more, but just want to make sure that it runs smooth everytime. This is a very rare issue but I was wondering if there is a way to mitigate this. All I could think about is to add 3-5 seconds after opening and after closing the excel workbook.

Let me know.

Thanks
 
Upvote 0
Try inserting this line of code:
Code: 
Application.Wait (Now + TimeValue("00:00:05"))
after
Code: 
wkbDest.Close True
This will pause the macro for 5 seconds before opening the next file.
 
Upvote 0
Hello,

Do you know what the below highlighted piece of code line is trying to do because the users are running into errors this morning and the debug mode takes me here.
Code: 
[COLOR=#333333]Sub InProcessRecon()[/COLOR]    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 = srcWS.Cells(fVisRow, 4)
                    Day1 = Left(Right(sDate, 4), 2)
                    If Day1 = "01" Then
                        [B][COLOR=#ff0000]Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))[/COLOR][/B]
                        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
    Next key
    Application.CutCopyMode = False
    Application.ScreenUpdating = True [COLOR=#333333]End Sub[/COLOR]
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Copy Paste data from one source document to multiple excel documents
Replies
0
Views
544
babar2019
B

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top