• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Retrieve key cols from multiple workbook and prepare report

Try this new demonstration !​
Code: 
Private Sub Demo()
    Const E = ";Extended Properties=""Excel 12.0;IMEX=1;HDR=No"""
    Dim oCn As Object, P$, F$, N, V, VH, R&, T, W, H%(3), C%, K$, VA#()
          P = ThisWorkbook.Path & "\"
          F = Dir(P & "*.xlsx"):  If F = "" Then Beep: Exit Sub
          Me.UsedRange.Offset(1).Clear
          [E2].Value = "      Wait …"
          N = Array([{"country*"}], [{"curr*"}], [{"gl acc*"}], [{"revenue","Non funded income","NFI"}])
          P = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & P
    Set oCn = CreateObject("ADODB.Connection")
With CreateObject("Scripting.Dictionary")
    Do
             oCn.Open P & F & E
        With oCn.Execute("SELECT * FROM [Sheet1$]")
            V = .GetRows
                .Close
        End With
             oCn.Close
           VH = Application.Index(V, , 1)
        For R = 0 To 3
            For Each T In N(R)
                W = Application.Match(T, VH, 0)
                If IsNumeric(W) Then H(R) = W - 1: Exit For
            Next
                If IsEmpty(T) Then Exit For
        Next
        If T > "" Then
                C = -(F Like "Corebanking*")
            For R = 1 To UBound(V, 2)
                K = V(0, R) & vbTab & V(H(0), R) & vbTab & V(H(1), R) & vbTab & V(H(2), R)
                If .Exists(K) Then VA = .Item(K) Else ReDim VA(1)
                   VA(C) = VA(C) + V(H(3), R)
                .Item(K) = VA
            Next
        End If
               F = Dir
    Loop Until F = ""
          R = .Count
    Set oCn = Nothing
    [A2].Resize(R).Value = Application.Transpose(.Keys)
    [A2].Resize(R).TextToColumns Tab:=True
    [E2:F2].Resize(R).Value = Application.Index(.Items, 0)
    .RemoveAll
End With
    With [A2:F2].Resize(R).Columns
        .Item("E:G").NumberFormat = Cells(7).NumberFormat
            .Item(8).NumberFormat = Cells(8).NumberFormat
                 .Item(7).Formula = "=F2-E2"
                 .Item(8).Formula = "=IF(F2=0,""-"",E2/F2)"
                 .Item(9).Formula = "=IF(E2=F2,""R"",""Not r"")&""econciled"""
             .Item("G:I").Formula = .Item("G:I").Value
    End With
End Sub
You should Like it !
​
 
Thats it . Wow finally my expected result :) :) no words Marc , you are great. Sweet Thanks . Self pat on my back for sharing the correct requirements !!!
 
:DD

Yes as we are not on a mind readers forum,
a crystal clear and complete explanation
with an attachment reflecting real data layout
is necessary as soon as the thread creation !

The better initial post, the better and quicker code …
​
 
The data format changed in this month's file hence getting run 13 type mismatch error . :(
 

Attachments

  • Corebanking.xlsx
    13.5 KB · Views: 13
  • Payment.xlsx
    37.8 KB · Views: 8
  • Summary.xlsb
    22 KB · Views: 5
Bad data workbook ‼
Open Corebanking, delete row #2, close and save …

As a reminder :
Marc L said:
As in my first post in this thread I clearly asked about workbooks names, I can't waste time anymore,
you must fix & set a definitive context
Click to expand...
 
There is nothing wrong with the excel sheets, I have given the requirements and also the code which is working you gave is perfectly working . No qualms . The data i receive is very dynamic . I guess it is highly unlikely for anybody to predict the possible scenarios on which you can receive the data . The blanks ones are valid ones also the Gl account number column the length of the accounts has possible cases of 18 digit in length . if the two workbooks does not have any currency or gl account still in the case the data should be in summary report as null . This is very rare occurence where we have both currency and gl account has come null .
 
Last edited:
Guruprasad1987 said:
The blanks ones are valid ones also the Gl account number column the length of the accounts has possible cases of 18 digit in length . if the two workbooks does not have any currency or gl account still in the case the data should be in summary report as null .
Click to expand...
You never mentionned this and never joined such worksheet ‼
As I asked several times for all possible cases
and a fixed and definitive context !

I'll need to see an expected result worksheet for this brand new case …

You had the choice between a Ferrari and an old Jeep Willis,
you choose the Ferrari which is very appropriate on good roads.
But now you go for some off-road, so you must drive very slower
'cause of any big hole or stone.
But the Jeep Willis was the best choice for that kind of land !

Here it's the same, you have a Ferrari code
which can't work for all worksheet layout types …
Works only with smart worksheets,
not for those created by Dumb or Dumber !

So for last time, think about all possible cases,
post them here with according attachment …

In case of a future code, it will take care only
of your next global explanations and attachment,
not on any previous post !
And do not be surprised in case of a Jeep Willis code
very very slower but at least maybe stronger …
​
 
I will prepare the worksheets covering all the scenarios and share it with you at the earliest. Your code is undoubtedly rectified my issues for most of the countries . Except there are few countries where the gl acocunt number formats are different .

Dim oCn As Object, P$, F$, V, C%, R&, K$, VA

I see that all the variables are declared as object . Am not sure if the run error is due to this . As you mentioned I removed the blank entries from # row 2 from corebanking earlier . Still i get the run time error .
 
Only oCn is an Object variable ‼
As you can control variables types during execution in VBE Locals window.
Read also VBA inner help for Integer, Long and String variable type …

After row #2 deleted and file saved, code works like a charm on my side !

Error comes from empty cells with Ferrari data engine.
Can be bypassed but another error should occur
'cause of sign "-" instead of a value and can be bypassed too
but as a NES, I'm waiting at least for a clear context …
(NES : never ending story !)​

Guruprasad1987 said:
if the two workbooks does not have any currency or gl account still in the case the data should be in summary report as null.
Click to expand...
In this case according to your last attachment,
result data has around 300 rows, do you think that's correct ?!
So according to this result worksheet, well define criterias …​
 

Attachments

  • Result .xlsb
    12.8 KB · Views: 4
Thats the perfect result I expect !!! Am not sure despite your advice I tried removing the blank records in my input file , I am still getting the same result . Thats my final input final covering all the needed scenarios .
 
Try this last Ferrari demonstration first with your post #33 attachment
Edit v2 :​
Code: 
Option Compare Text

Function VHeaders(W)
    Dim F&, V, R&
        On Error Resume Next
        F = LBound(W, 2):  If Err.Number Then Exit Function
        V = Application.Index(W, , 1)
    If Not IsArray(V) Then
        ReDim V(UBound(W))
        For R = LBound(W) To UBound(W):  V(R) = W(R, F):  Next
    End If
        VHeaders = V
End Function

Private Sub Demo()
         Const D = "¤", E = ";Extended Properties=""Excel 12.0;IMEX=1;HDR=No"""
         Dim oCn As Object, P$, F$, M$, N, V, VH, R&, T, W, H%(3), B%, C%, K$, VA#()
          P = ThisWorkbook.Path & "\"
          F = Dir(P & "*.xlsx"):  If F = "" Then Beep: Exit Sub
          Me.UsedRange.Offset(1).Clear
          [E2].Value = "        Wait  …"
          M = "Bad Headers :"
          N = Array([{"country*"}], [{"curr*"}], [{"gl acc*"}], [{"revenue","Non funded income","NFI"}])
          P = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & P
         Set oCn = CreateObject("ADODB.Connection")
With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
    Do
             oCn.Open P & F & E
        With oCn.Execute("SELECT * FROM [Sheet1$]")
            V = .GetRows
                .Close
        End With
             oCn.Close
               VH = VHeaders(V)
    If IsArray(VH) Then
        For R = 0 To 3
            For Each T In N(R)
                W = Application.Match(T, VH, 0)
                If IsNumeric(W) Then H(R) = W - 1: Exit For
            Next
                If IsEmpty(T) Then B = B + 1: M = M & D & F: Exit For
        Next
        If T > "" Then
                C = -(F Like "corebanking*")
            For R = 1 To UBound(V, 2)
                K = V(0, R) & vbTab & V(H(0), R) & vbTab & V(H(1), R) & vbTab & V(H(2), R)
                If .Exists(K) Then VA = .Item(K) Else ReDim VA(1)
                If IsNumeric(V(H(3), R)) Then VA(C) = VA(C) + V(H(3), R)
                .Item(K) = VA
            Next
        End If
    Else
        B = B + 1:  M = M & D & F
    End If
               F = Dir
    Loop Until F = ""
               R = .Count
         Set oCn = Nothing
    [A2].Resize(R).Value = Application.Transpose(.Keys)
    [A2].Resize(R).TextToColumns Tab:=True, FieldInfo:=Array([{1,2}], [{2,2}], [{3,2}], [{4,2}])
    [E2:F2].Resize(R).Value = Application.Index(.Items, 0)
    .RemoveAll
End With
    With [A2:F2].Resize(R).Columns
        .Item("E:G").NumberFormat = Cells(7).NumberFormat
            .Item(8).NumberFormat = Cells(8).NumberFormat
                 .Item(7).Formula = "=F2-E2"
                 .Item(8).Formula = "=IF(F2=0,""-"",E2/F2)"
                 .Item(9).Formula = "=IF(E2=F2,""R"",""Not r"")&""econciled"""
             .Item("G:I").Formula = .Item("G:I").Value
    End With
    If B Then
        MsgBox "some bad headers workbook" & IIf(B > 1, "s", ""), vbExclamation, "  Done but …"
        V = Split(M, D)
        [M2].Resize(UBound(V) + 1).Value = Application.Transpose(V)
    End If
End Sub
You could Like it !
​
 
You must log in or register to reply here.
Back
Top