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

[babar2019]

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]

 

[mumps]

Here are the links to your files. Give them a try. They work for me.

https://app.box.com/s/t9v3zj6ipcn2mgo5p1zlhw652s8th008
https://app.box.com/s/im0tbzhmvyjjkj4h06d7tjqobxiu10ue

 

[babar2019]

Let me tell you what my findings are:

When I run the code, all the rows in the source file are hidden which is why it is running into that error 'cannot find cells'. I unhide the rows and run the macro again and now it errors out on the below code line saying 'Subscript out of range'.

Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(key2, 2), Left(key2, Len(key2) - 4), Mid(key2, Len(key2) - 3, 2)), "mmyy"))

 

[mumps]

I can't reproduce the problem. Click here to download the result that I get.

 

[babar2019]

Good morning,

I saw your results. Can you send me the step by step process of what you're doing so I can try to follow the same thing?

Thank you

 

[mumps]

Make sure that the source workbook and the destination workbooks have all been saved in the same folder. The macro must be in a standard module in the Source workbook and run it from there. The Source workbook must be the only workbook open. Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. Double click Module1 so that the macro is visible. Click anywhere in the code and press the F5 key. There are other quicker ways to run the macro such as assigning it to a button that you would click on your sheet or assigning it to a short cut key.

 

[babar2019]

Hello..Thank you. I got it to work.

There are some formatting changes and a few formulas that I'd like to add. Do you mind adding this to the code?

Column B
Font - Bookman Old Style
Font Color - Dark Blue
Size -10pt
format - mm/dd/yy
left alignment


Column C
Font - Bookman Old Style
Size -10pt
left alignment


Column D
Font - Bookman Old Style
Font Color - Dark Blue
Size -10pt
left alignment


Column E
Font - Bookman Old Style
Font Color - Dark Blue
Size -10pt
center alignment


Column F
Font - Bookman Old Style
Font Color - Dark Blue
Size -10pt


Right now Column E(DHITC) in the source file contains number values. Please paste the values as it is instead of the words Debit/Credit into the destination file.
The Amount column in the destination file needs to be a negative value if Column E is 55 or 78(debit) and positive if Column E is 18 or 38(Credit).

Example: Source File - Column E(DHITC) - 55
Column F(DHAMT) - 100
Destination File - Column E(55/18) - 55
Column F(Amount) - (100.00)


Column G should be a formula field - If E (current row) is 55 or 78, then F(current row) else 0.
Column H should be a formula field - If E (current row) is 18 or 38, then F(current row) else 0.
Column I should be a formula field - H(current row) + G(Current Row) + I(previous row)

Is there anyway to adjust the 'Reconciliation totals' row for Column F,G,H in the destination file? It would be good if the formula can auto calculate. Right now it looks like after you paste the cells, the formula doesn't get updated.

Here's the link below to the latest document uploaded to Box so you know what I'm exactly talking about. Please go to 0719 tab and see my formatting and the formulas that I'm referencing above:
https://esquirebank.box.com/s/nq1xd85v0rzugr7qxk7rm9o6cjph3omk


Thank you very much in advance

 

[mumps]

Here are the links to the revised files. Please have a look at the formulas in range F67:I67 of the destination workbook. In order for the formulas to update as rows of data are inserted, you will have to change the formulas in that range for all the destination files.
https://app.box.com/s/im0tbzhmvyjjkj4h06d7tjqobxiu10ue
https://app.box.com/s/qz3659esz399olcjfrudx3zt6lo3vqbz

 

[babar2019]

Good morning,

Thank you for the updated files.

The issue now is that the code is trying to add '-' to all the debit values in Column F & G but it is doing even for all the previously done rows and not just the ones it's pasting. This is leading to add double'--' to the previous values which is messing the formulas.

Example, if the previous row shows "-100.00", then the code is pasting newer rows and modifying the previous value to show as "--100.00". The newly added rows have no issue. They are perfectly fine.I have uploaded a screenshot of what I'm talking.

Here's the link: https://esquirebank.box.com/s/7o3g1gfjc5nhqyge1yin1vwz049poxk5

Thank you in advance

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key1 As Variant, key2 As Variant, totals1 As Long, totals2 As Long
    Dim RngList1 As Object, RngList2 As Object, rng As Range, rng1 As Range, rng2 As Range, arr As Variant, i As Long, fNames As String, code As Variant
    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 RngList1 = CreateObject("Scripting.Dictionary")
    Set RngList2 = CreateObject("Scripting.Dictionary")
    For Each rng1 In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList1.Exists(rng1.Value) Then
            RngList1.Add rng1.Value, Nothing
        End If
    Next rng1
    For Each key1 In RngList1
        For i = 0 To UBound(arr)
            If arr(i) = key1 Then
                Set wkbDest = Workbooks.Open(ThisWorkbook.Path & "\" & arr(i + 1) & ".xlsx")
                With srcWS.Cells(1).CurrentRegion
                    .AutoFilter 1, key1
                    For Each rng2 In srcWS.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
                        If Not RngList2.Exists(rng2.Value) Then
                            RngList2.Add rng2.Value, Nothing
                        End If
                    Next rng2
                    For Each key2 In RngList2
                        Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(key2, 2), Left(key2, Len(key2) - 4), Mid(key2, Len(key2) - 3, 2)), "mmyy"))
                        With srcWS.Cells(1).CurrentRegion
                            .AutoFilter 4, key2
                            totals1 = desWS.Range("C:C").Find("Reconcilation 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("Reconcilation 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
                        End With
                        srcWS.Cells(1).AutoFilter
                    Next key2
                    totals2 = desWS.Range("C:C").Find("Reconcilation 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
                    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 = "55" Or code = "78" 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 = "18" Or code = "38" 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
                    End With
                End With
            End If
        Next i
        RngList2.RemoveAll
        'wkbDest.Close True
    Next key1
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[babar2019]

Good morning,

Thanks, this works great.

I just don't know what do to with dynamically updating the 'Reconciliation Totals' row..

I would not like the users to manually change it every time as this would defeat the purpose of automation and they do this process everyday.

Do you have any suggestions?
Can we take the last row number after we paste and modify the formula with the macro itself?

For examplle, if it is (F1:F67), we added 3 more rows, Can macro know to modify to (F1:F70) automatically.

Thank you much