Consulting

Results 1 to 11 of 11

Thread: Export Multiple wbk

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    16
    Location

    Export Multiple wbk

    Hi All

    i need some improvement in code that code isn't working when i create header as per my need and when i remove all header code working fine!

    2nd issue is this that there is total count of column A isn't equal to column C count so last WBK isn't generating with 100 numbers it should be generated with remaining numbers is whatever in count!

    Sub test()
        Dim a, b, i As Long, ii As Long, n As Long, t As Long, HDR As String, x
        HDR = "Customer ID,Mobile Number,Customer Name,CNIC,Email Address,Package Plan,Bolton1," & _
            "Bundles,Connection Status,Access Level,Credit Limit,Natureof Sales," & _
            "Deposit Amount/Waiver Code,Special Line Level Info,Special Number Charge Type," & _
            "Hand Set,Special Number Charges,ICCID,Verified,Comments,Sales Feedback,SPOCMSISDN,Sales ID"
        a = [a2].CurrentRegion.Value
        x = [index(b2:b1000&"-"&c2:c100&if(countifs(b2:b1000,b2:b1000,c2:c1000,c2:c1000)>1,"-"&countifs(offset(b2:b1000,,,row(1:1000)),b2:b1000,offset(c2:c1000,,,row(1:1000)),c2:c1000),""),,)]
        For i = 1 To UBound(a, 1)
            If a(i, 3) = "" Then Exit For
            ReDim b(1 To a(i, 3))
            For ii = t + 1 To UBound(a, 1)
                If a(i, 3) = "" Then Exit For
                n = n + 1
                b(n) = "," & Format$(Replace (Replace (a(ii, 1), "-", ""), " ", ""), _
                    String(9, "0")) & String(12, ",") & a(i, 4) & String(10, ",") & a(i, 2)
                If n = a(i, 3) Then
                    Open ThisWorkbook.Path & "\" & x(i, 1) & ".csv" For Output As #1
                        Print #1, Join(Array(HDR, Join(b, vbCrLf)), vbCrLf);
                    Close #1
                    t = ii: n = 0: Exit For
                End If
        Next ii, i End Sub

    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,894
    At first sight:
    a = [a2].CurrentRegion.Value
    includes row 1 of the sheet.
    Try (if you know there will always be a header on the sheet):
    a = Intersect([a2].CurrentRegion, [a2].CurrentRegion.Offset(1)).Value

    I haven't understood your second 'issue' at all.
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,770
    The uploaded file doesn't contain macros.
    It's not clear what result you are after.
    The columnheaders do not match the information in the macro.
    Some columnheaders contain formulae: that is ridiculous.
    Did you write this code yourself ?
    Last edited by snb; 01-04-2020 at 08:59 AM.

  4. #4
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,894
    Quote Originally Posted by p45cal View Post
    I haven't understood your second 'issue' at all.
    Maybe instead of:
    If n = a(i, 3) Then
    try:
    If n = a(i, 3) Or ii >= UBound(a, 1) Then

    but I think this will only handle if the sum of column C is greater than the number of rows-1 in [A2].currentregion, I haven't tested.
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    VBAX Regular
    Joined
    Mar 2019
    Posts
    16
    Location
    Quote Originally Posted by p45cal View Post
    At first sight:
    a = [a2].CurrentRegion.Value
    includes row 1 of the sheet.
    Try (if you know there will always be a header on the sheet):
    a = Intersect([a2].CurrentRegion, [a2].CurrentRegion.Offset(1)).Value
    Thank you sir this is working now!

    Adeel

  6. #6
    VBAX Regular
    Joined
    Mar 2019
    Posts
    16
    Location
    Quote Originally Posted by p45cal View Post
    Maybe instead of:
    If n = a(i, 3) Then
    try:
    If n = a(i, 3) Or ii >= UBound(a, 1) Then

    but I think this will only handle if the sum of column C is greater than the number of rows-1 in [A2].currentregion, I haven't tested.
    its isn't working let me explain more!
    as per column C there should be 4 wbks generated but isn't because for last wbk numbers isn't 150 remain in sheet, i want whatever is remaining number in sample wbk , wbk book export with remaining numbers count!

    Adeel

  7. #7
    VBAX Regular
    Joined
    Mar 2019
    Posts
    16
    Location
    Quote Originally Posted by snb View Post
    The uploaded file doesn't contain macros.
    It's not clear what result you are after.
    The columnheaders do not match the information in the macro.
    Some columnheaders contain formulae: that is ridiculous.
    Did you write this code yourself ?
    thnx for help sir, macros i posted in below of my opening post. in sample wbk headers are different and in exported wbk header will be different which came from code!
    i haven't write this code as i don't have idea of macros!

    Adeel

  8. #8
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,770
    i don't have idea of macros
    Then stay away from them as far as possible.

  9. #9
    VBAX Regular
    Joined
    Mar 2019
    Posts
    16
    Location
    Quote Originally Posted by snb View Post
    Then stay away from them as far as possible.
    thanks for your suggestion sir, i will keep this in my mind! in short means if any of don't know about macro/VBA they aren't allowed to post question here.

    Adeel

  10. #10
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,894
    Quote Originally Posted by Adeel View Post
    its isn't working let me explain more!
    as per column C there should be 4 wbks generated but isn't because for last wbk numbers isn't 150 remain in sheet, i want whatever is remaining number in sample wbk , wbk book export with remaining numbers count!
    I made the 2 changes I suggested leaving:
    Sub test()
    Dim a, b, i As Long, ii As Long, n As Long, t As Long, HDR As String, x
    HDR = "Customer ID,Mobile Number,Customer Name,CNIC,Email Address,Package Plan,Bolton1," & _
          "Bundles,Connection Status,Access Level,Credit Limit,Natureof Sales," & _
          "Deposit Amount/Waiver Code,Special Line Level Info,Special Number Charge Type," & _
          "Hand Set,Special Number Charges,ICCID,Verified,Comments,Sales Feedback,SPOCMSISDN,Sales ID"
    a = Intersect([a2].CurrentRegion, [a2].CurrentRegion.Offset(1)).Value
    x = [index(b2:b1000&"-"&c2:c100&if(countifs(b2:b1000,b2:b1000,c2:c1000,c2:c1000)>1,"-"&countifs(offset(b2:b1000,,,row(1:1000)),b2:b1000,offset(c2:c1000,,,row(1:1000)),c2:c1000),""),,)]
    For i = 1 To UBound(a, 1)
      If a(i, 3) = "" Then Exit For
      ReDim b(1 To a(i, 3))
      For ii = t + 1 To UBound(a, 1)
        If a(i, 3) = "" Then Exit For
        n = n + 1
        b(n) = "," & Format$(Replace(Replace(a(ii, 1), "-", ""), " ", ""), _
                             String(9, "0")) & String(12, ",") & a(i, 4) & String(10, ",") & a(i, 2)
        If n = a(i, 3) Or ii >= UBound(a, 1) Then
          Open ThisWorkbook.Path & "\" & x(i, 1) & ".csv" For Output As #1
          Print #1, Join(Array(HDR, Join(b, vbCrLf)), vbCrLf);
          Close #1
          t = ii: n = 0: Exit For
        End If
      Next ii
    Next i
    End Sub
    and got the 4 attached files. The last one (C8965-150.csv) has 100 data rows instead of 150 (because 1500+1000+2400+150 = 5050, but you ounly have 5000 rows of data).
    Attached Files Attached Files
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  11. #11
    VBAX Regular
    Joined
    Mar 2019
    Posts
    16
    Location
    thank you so much sir for your time and help!its working

    Adeel

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •