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!

Code:

---

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

---

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.

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 ?

Quote:

---

Originally Posted by 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.

Quote:

---

Originally Posted by 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

---

Thank you sir this is working now!

Adeel

Quote:

---

Originally Posted by p45cal

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

Quote:

---

Originally Posted by 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 ?

---

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

Quote:

---

i don't have idea of macros

---

Then stay away from them as far as possible.

Quote:

---

Originally Posted by snb

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.:thumb

Adeel

Quote:

---

Originally Posted by Adeel

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:

Code:

---

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

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

Adeel