Export Multiple wbk

[Adeel]

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

[p45cal]

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]

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.

[Adeel]

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

[p45cal]

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).

[Adeel]

thank you so much sir for your time and help!its working

Adeel

[Adeel]

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

[snb]

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 ?

[Adeel]

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

[snb]

i don't have idea of macros

Then stay away from them as far as possible.

[Adeel]

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