Export table data to excel (1 Viewer)

arnelgp

error reading drive A:
Local time
Tomorrow, 03:54
Joined
May 7, 2009
Messages
9,336
try this:


wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count)).Name = "Order"
 

suryu

Member
Local time
Tomorrow, 01:24
Joined
Apr 3, 2020
Messages
55
Hi @arnelgp,
Hope you are doing good

i have one doubt

i want to split id value present in one row to columnwise data see below for details

>> If in excel B2 value is 10001;10002;10003
it should give value column wise in C2, D2,E2 delimited ; i.e, 10001,10002,10003 using vba

i am trying to do like below code

splitstring=thisworkbook.sheets("sheet1").cells(1,2).value

myarray=split(splitstring,";")

for i=0 to UBound(myarray)

?
next

confused whether to take for loop or while because delimiter ; can b more than 3,4

kindly do suugest

thank you
 

arnelgp

error reading drive A:
Local time
Tomorrow, 03:54
Joined
May 7, 2009
Messages
9,336
rename Sheet1 in the code with your sheet name
Code:
Dim r As Range
Dim rValue As String
Dim vValue As Variant
Dim v As Variant
Dim i As Integer
Dim cValue As New Collection
Set r = Sheet1.Range("b2")
rValue = r.Value
If r Like "*;*" Then
    vValue = Split(rValue, ";")
    For Each v In vValue
        If Trim(v & "") <> "" Then
            cValue.Add v & ""
        End If
    Next
End If
For i = 1 To cValue.Count
    r.Offset(0, i).Value = cValue.Item(i)
Next
Set cValue = Nothing
Erase vValue
 

suryu

Member
Local time
Tomorrow, 01:24
Joined
Apr 3, 2020
Messages
55
Hi @arnelgp
Above code is fine but i want to do for the particular column till last row

>> Data is given in the below format

CustomerCollateral IdStatus
Ramesh008023378 ; 011123884 ; 0092346-9734;
Suresh;102333345
Mohan#

>> I need data in below format

CustomerCollateral IdCollateral Id1Collateral Id2Status
Ramesh008023378 ;011123884 ;0092346-9734;
Suresh;102333345
Mohan0

>>please find the below code i have done it is giving data seperated by delimiter.
>>facing issues how to rename column header after seperation

Private Sub CommandButton1_Click()

Dim a As Integer
Dim i As Integer
Dim LastRow As Integer
Dim SplitString As String
Dim myarray() As String

LastRow = Range("B" & Rows.Count).End(xlUp).Row

For a = 2 To LastRow
SplitString = ThisWorkbook.Sheets("Sheet1").Cells(a, 2).Value
myarray = Split(SplitString, ";")

For i = 0 To UBound(myarray)
ThisWorkbook.Sheets("Sheet1").Cells(a, i + 2).Value = myarray(i)
Next

Next


End Sub
 
Last edited:

arnelgp

error reading drive A:
Local time
Tomorrow, 03:54
Joined
May 7, 2009
Messages
9,336
Code:
Dim sh As Worksheet
Dim r As Range
Dim last_row As Long
Dim column_header As String
Dim c As New Collection
Dim m As New Collection
Dim i As Long, j As Long, k As Long
Dim max_column As Byte
Dim n As Byte
Dim v As Variant

Set sh = Sheet1
Set r = sh.Range("b1")
column_header = r.Value

last_row = sh.Range("A" & Rows.Count).End(xlUp).Row
'save ids to collection and at the same time
'determine the max column to make
For i = 2 To last_row
    n = delim_count(sh.Range("b" & i).Value & "")
    If n > max_column Then
        max_column = n
    End If
    c.Add sh.Range("b" & i).Value & ""
Next
'insert the column
Call insert_column(sh.Range("c:c"), max_column - 1)
'put the title
For i = 1 To max_column - 1
    r.Offset(0, i).Value = column_header & i
Next
'remove blank item from collection
'and put the ids
For i = 1 To c.Count
    v = Split(c.Item(i), ";")
    For j = 0 To UBound(v)
        If Trim(v(j)) <> "" Then
            m.Add Replace(Trim(v(j)), ";", "")
        End If
    Next
    For j = 0 To m.Count - 1
        r.Offset(i, j) = m.Item(j + 1)
    Next
    Set m = New Collection
Next
Set c = Nothing
Set m = Nothing
Erase v

End Sub

Public Function delim_count(ByVal s As String, Optional d As String = ";") As Byte
Dim n_pos As Integer, n As Byte
n_pos = InStr(1, s, d)
While n_pos > 0
    n = n + 1
    n_pos = InStr(n_pos + 1, s, d)
Wend
delim_count = n
End Function


Public Function insert_column(r As Range, Optional num_to_insert As Byte = 1)
    Dim i As Byte
    For i = 1 To num_to_insert
        r.Select
        Application.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Next
End Function
 

suryu

Member
Local time
Tomorrow, 01:24
Joined
Apr 3, 2020
Messages
55
Code:
Dim sh As Worksheet
Dim r As Range
Dim last_row As Long
Dim column_header As String
Dim c As New Collection
Dim m As New Collection
Dim i As Long, j As Long, k As Long
Dim max_column As Byte
Dim n As Byte
Dim v As Variant

Set sh = Sheet1
Set r = sh.Range("b1")
column_header = r.Value

last_row = sh.Range("A" & Rows.Count).End(xlUp).Row
'save ids to collection and at the same time
'determine the max column to make
For i = 2 To last_row
    n = delim_count(sh.Range("b" & i).Value & "")
    If n > max_column Then
        max_column = n
    End If
    c.Add sh.Range("b" & i).Value & ""
Next
'insert the column
Call insert_column(sh.Range("c:c"), max_column - 1)
'put the title
For i = 1 To max_column - 1
    r.Offset(0, i).Value = column_header & i
Next
'remove blank item from collection
'and put the ids
For i = 1 To c.Count
    v = Split(c.Item(i), ";")
    For j = 0 To UBound(v)
        If Trim(v(j)) <> "" Then
            m.Add Replace(Trim(v(j)), ";", "")
        End If
    Next
    For j = 0 To m.Count - 1
        r.Offset(i, j) = m.Item(j + 1)
    Next
    Set m = New Collection
Next
Set c = Nothing
Set m = Nothing
Erase v

End Sub

Public Function delim_count(ByVal s As String, Optional d As String = ";") As Byte
Dim n_pos As Integer, n As Byte
n_pos = InStr(1, s, d)
While n_pos > 0
    n = n + 1
    n_pos = InStr(n_pos + 1, s, d)
Wend
delim_count = n
End Function


Public Function insert_column(r As Range, Optional num_to_insert As Byte = 1)
    Dim i As Byte
    For i = 1 To num_to_insert
        r.Select
        Application.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Next
End Function
Thank you so much its working fine :)
 

suryu

Member
Local time
Tomorrow, 01:24
Joined
Apr 3, 2020
Messages
55
Hi @arnelgp,
I have doubt on below :

I have sub folder inside folder name 2020, with today date and there are pdf files are inside that like below scrrenshot

1591267221244.png

in datefolder loan pdf files are there, and in excel folder same count of loan numbers are there rowwise in range("G")

I need to match whether count of loans in excel is same as count of pdf, then i need to convert datefolder to zip one.

Kindly help me its urgent.

Thank you
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom