Excel Macro Help

[babar2019]

Hi - I need help with the macro below:

I have a source worksheet which has Column A (description) and Column B (A/C #).
Currently the macro runs based off of Column A and I need it to change to go by Column B which contains numeric value.
I made some adjustments as follows to refer to column B and I run into an "Object variable or with block variable not set" run-time error.

Original: fNames = "AURORA PAYMENTS (FISERV),In Process DDA Recon - Aurora Payments (Fiserv)"
Adjusted: fNames = "2940003102,In Process DDA Recon - Aurora Payments (Fiserv)"

Original: For Each rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
Adjusted: For Each rng In srcWS.Range("B2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))

Original: fVisRow = srcWS.Range("A1", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
Adjusted: fVisRow = srcWS.Range("B1", srcWS.Range("B" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row

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
    Dim answer As Integer
    
    'Source File Sheet name
    Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    'Opening In Process files based on the value coming from source file
    fNames = "2940003102,In Process DDA Recon - Aurora Payments (Fiserv)"
        
        answer = MsgBox("Do you wish to roll over the Month End Data?", vbQuestion + vbYesNo + vbDefaultButton2, "Month End Roll Over")
        
        arr = Split(Application.Trim(fNames), ",")
    Set RngList = CreateObject("Scripting.Dictionary")
   [B] [/B]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 answer = vbYes 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:J" & 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"
                        .Replace "58", "DR"
                        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("G10:J10").Copy
                            .Range("G10:J" & 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))"
                        End With
                    Else
                        GoTo totals1
                    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

 

[Micron]

The trouble with this site is that horizontal scroll bar won't appear until you get near the bottom. So to see a lot of that, we (at least I) have to try to mark my place, scroll down, scroll across then back up and hope I didn't scroll too far. So I took the liberty of doing a few things to help others to avoid that and maybe make things a bit easier to troubleshoot (e.g. I put like variables together so that if you're reading code and wonder what a variable name is, sometimes easier to decipher if grouped). Not sure I see the logic in doing a bunch of stuff if user selects no. Shouldn't that be 1st so that nothing gets Set or disabled? Also, a bunch of stuff will happen regardless of a no answer? Last, I'm guessing the line that errors is the one you tried to bold. I don't think the forum permits user formatting of vba code. I also took the liberty of using line continuation characters to stop the scrolling. A note or 2 in there as well.

My guess is that it's because you declared rng as a Range, which is an object. All objects must be Set before you can use them. Try
For Each Range ... or perhaps find a way to put the Set rng statement within the loop.

Sub InProcessRecon()
Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, prevWS As Worksheet
Dim LastRow As Long, totals As Long, totals1 As Long, totals2 As Long, fVisRow As Long, i As Long
Dim fNames As String, sDate As String, Day1 As String
Dim code As Variant, key As Variant, arr As Variant
Dim RngList As Object, rng As Range
Dim answer As Integer

Application.ScreenUpdating = False
   
'Source File Sheet name
Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Opening In Process files based on the value coming from source file
fNames = "2940003102,In Process DDA Recon - Aurora Payments (Fiserv)"

'code will continue regardless of what the user choice is??
'answer = MsgBox("Do you wish to roll over the Month End Data?", vbQuestion + vbYesNo + vbDefaultButton2, "Month End Roll Over")

'same result should result from adding constants of 32+4+256
answer = MsgBox("Do you wish to roll over the Month End Data?", 292, "Month End Roll Over")
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
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 answer = vbYes 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:J" & 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"
                    .Replace "58", "DR"
                    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("G10:J10").Copy
                        .Range("G10:J" & 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))"
                    End With
                Else
                    GoTo totals1
                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

 

[babar2019]

Hi @Micron Thanks for your response. Basically if the Answer to the popup is selected 'Yes', it will do a bunch of stuff above the 'Totals1' section and run everything down. But if the Answer is 'No', it will skip directly to 'Totals1' section and run it from there.

Unfortunately it is a complicated process and someone from this wonderful group helped me put this code together a few years back.. I'm actually inexperienced in vba. If you think some changes are required, Can you please include what exactly the change should be so I can test it on my end and see if it works out.

 

[Micron]

My ISP was down country wide all day yesterday

I interpret the process to be
- turn off updating
- set srcWS object, assign LastRow, fNames variables value
- assign msgbox response to answer variable
- split fNames
- set dictionary object
- do range loop
- do key loop and nested workbook open loop

All that happens regardless of what choice the user makes. Then inside the inner loop of the key loop, do a LOT of stuff if the answer was yes.
If the answer was not Yes, goto totals1. That's where it gets real interesting. It seems to me that would cause an infinite loop where that whole section from desWs to GoTo would repeat regardless of what the answer was because the IF test would not be applied. Don't know what the impact of that would be when it gets to the Else - probably would skip it and go to Next i, which would explain why you'd never notice the duplicate running of a section, assuming I'm correct in the analysis.
After the i loop is done, you should get the "In process..." message.

I suggest you put a break point on the arr= line and cause the code to run. Answer No, then continue line by line (press F8) and watch what happens, keeping in mind that you said no. If I'm wrong, then I can't be too specific because not having the file meant I couldn't validate what I'm seeing. However, I don't see the point of doing anything before presenting a msgbox whose No answer means nothing should be done (at least that's my interpretation of what No means here).

So I would do this after Dim answer As Integer:
answer = Msgbox("Do you wish...
If answer = vbNo Then Exit Sub

Application.ScreenUpdating = False
etc.

You would then not need any If answer = tests since the value of answer could only be vbYes.
As for the message box question, wish is more correctly followed by the preposition "for", which wouldn't make sense here, while want is followed by "to". But if you like the sound of "wish to" vs "want to" then stick with that.

 

[babar2019]

Hi - I'm not sure if I'm following you but I think it would be better if you actually see what the automation is doing.

Here's a link to the folder with sample files. Please download all the 3 files to your desktop.
Box

If you open the two "In Process Recon..." excel files, both have some data in the 0622 & 0722 tabs.

All the automation supposed to do when you run the code is, a message box will pop up asking if you want to roll over the data, if you choose Yes, it will copy all the 0622 data into the 0722 tab since we are still in july it would go into the 0722 tab.

If you select No, all it will do is, take the data from the "CSipHIST 07-28-22.xls" file and populate it in the 0722 tab.

Simply open the "CSipHIST 07-28-22.xls" file and paste the vba code into a module and you can run each line at a time to see what the automation is doing.

All I'm trying to do is instead of running the automation based on Column A in the "CSipHIST 07-28-22.xls" file, I want it to run based on Column B in the "CSipHIST 07-28-22.xls" file which is the DHACCT column.

So in this case, if DHACCT column = 12345, it should update the AURORA PAYMENTS (TSYS) file and if DHACCT=56789 it should update the AURORA PAYMENTS (FISERV) file.

Thank you

 

[Micron]

I've been busy between social events and a wood working project that I have to get out the door if I want to get paid. So perhaps it will be a few days before I can devote the time to study and apply your instructions and decipher the results. Given that it was 3 weeks before you responded, I'm guessing it's not an emergency anyway. That means I'll have to start from post 1 to re-familiarize myself with the issue.
Maybe this bump will entice someone else to chime in.

 

[babar2019]

Hi @Micron I apologize I have been out sick which is why the delayed responses. The team has been manually managing it.

This for sure is a priority. Can you please look into this when you get a chance?

 

[Micron]

The following was proposed in a pm (used pm to thresh out the details on how to use the files) prior to posting as a solution. No reply yet so I'll post the suggested solution here and consider it done unless advised otherwise. My experience was that when the IF is not true then the error mentioned is raised because the object hasn't been set (the wb was not opened).

OK, the immediate fix to your post is what I thought. If this is never true:
If arr(i) = key Then

then this never happens
Set wkbDest = Workbooks.Open(ActiveWorkbook.Path & "\" & arr(i + 1) & ".xlsx")

thus workbook never opens. You might be able to solve by moving Close line within that If block as follows

GoTo totals1
End If
End With
wkbDest.Close True
End If
Next i