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]

That line of code defines the sheet name in the destination workbook. The sheet name represented by the variable "prevWS" is based on the date in column D of the sheet "QRYLIBA380.CSIPHIST>Sheet1", for example sheet "0919". If this sheet doesn't exist in the destination workbook, the macro will generate and error.

 

[babar2019]

Good morning,

I see.. But when users were trying to run the macro when the month turned over, it didn't run and they had to do it manually.

The Column D in the source file had a date of 110119, the macro should have copied everything from 1019 tab to 1119 tab and then copy paste the values from source to destination worksheet.

Here's an example source & destination file where it errors out: https://esquirebank.box.com/s/o3c6vdlmcuzveeuc4gw16y1702y23qh8

Can you please look into it for me?

Thank you

 

[mumps]

Try replacing this line of code:

Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))

with

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

 

[babar2019]

That worked perfectly. I will continue to test different scenarios.

 

[mumps]

Glad it worked out.

 

[babar2019]

Hello Mumps,
Is there a way to eliminate weekends and long weekends through vba? Right now what's happening is we hard coded "01" in our code but it looks like December 01 fell on a Sunday. so the report was generated on Monday the 2nd and the files did not roll over because code was looking to see if it's 01 and not 02 in the date column of the source file.

Is there a way to check to see if it's the first business day of the month from the source file, if it is, then roll the files over. If not just run the regular process.

Thank you

 

[mumps]

There is something that I could try. The problem is that column D in the source workbook is formatted as "General" and it has to be formatted as "Date" so that instead of displaying "100119" for example, it would display "10/01/2019".

 

[babar2019]

Is there a way the user can change the code manually every month based on whatever the first business day it is from "01" to "02" or "03" etc and the macro will still run fine?
I'm testing it on a file where the source file will have a date of "010220" because "02" is the first business day for January 2020, The macro does not roll the data over from "1219" worksheet over to "0120" worksheet.

 

[mumps]

Try this macro. It prompts you to enter the date of the first business day of the month.

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

 

[babar2019]

Does this prompt everytime? For example, since 2nd is the first business day of January, user will input 010220, will the files roll over from 1219 tab over to 0120 tab?

How about we do this the easiest way possible?
can we put a message box everytime asking ‘Do you want to roll over the month end data?’
If selected Yes, the if condition will run.
If selected No, just the regular else process will run.

we don’t have to worry about any logic here. Just when selected yes, take the data from the last months tab and roll it over to the current months tab.

Hope I was clear. TIA.