PDA

View Full Version : [SOLVED] Export Multiple wbk



Adeel
01-04-2020, 01:19 AM
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:10 00)),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
01-04-2020, 07:25 AM
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.

snb
01-04-2020, 07:45 AM
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 ?

p45cal
01-04-2020, 08:02 AM
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
01-04-2020, 09:56 AM
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

Adeel
01-04-2020, 10:01 AM
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

Adeel
01-04-2020, 10:05 AM
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
01-04-2020, 10:28 AM
i don't have idea of macros

Then stay away from them as far as possible.

Adeel
01-04-2020, 10:33 AM
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

p45cal
01-04-2020, 11:33 AM
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:10 00)),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
01-04-2020, 12:13 PM
thank you so much sir for your time and help!its working:yes

Adeel