Need concatenated data as

rehanemis

Board Regular
Joined
Aug 15, 2016
Messages
50
Hello,

I need the output from given information:

Here is the data information:

[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]No[/TD]
[TD]Mar[/TD]
[TD]May[/TD]
[TD]Sep[/TD]
[TD]Dec[/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD]5[/TD]
[TD]11[/TD]
[TD]7[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]21[/TD]
[TD]9[/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]21[/TD]
[TD][/TD]
[TD][/TD]
[TD]5[/TD]
[TD]7[/TD]
[/TR]
</tbody>[/TABLE]

The output required:
6 digit unique number for each row i.e 100011 + No + 2017 + Month Number(3) + 31 + amount (5)
so for all rows mentioned in above table the output required as:
100011,20,2017,3,31,5
100012,20,2017,5,31,11
100013,20,2017,9,31,7
100014,20,2017,12,31,8

Hope that make sense. I want to do it using vba.

Any suggestion please?
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
VBA is very specific. How are we to know which range these values are in? Which sheet? Anyway this helps a little

Code:
Dim table_arr, arr(), num1 As String, num2 As String, a As Long, mon_arr, i As Long, j As Long

mon_arr = Array("Jan", 1, "Feb", 2, "Mar", 3, "Apr", 4, "May", 5, "Jun", 6, "Jul", 7, "Aug", 8, "Sep", 9, "Oct", 10, "Nov", 11, "Dec", 12)
table_arr = Range("A1:E5")
num1 = 100011
num2 = 2017
a = 0

Range("F:F").ClearContents
For i = 2 To UBound(table_arr, 1) Step 1
    For j = 2 To UBound(table_arr, 2) Step 1
        If Len(table_arr(i, j)) > 0 Then
            ReDim Preserve arr(0 To a)
            arr(a) = num1 & "," & table_arr(i, 1) & "," & num2 & "," & mon_arr(Application.Match(table_arr(1, j), mon_arr, 0)) & ",31," & table_arr(i, j)
            a = a + 1
            num1 = num1 + 1
        End If
    Next
Next
Range("F1").Resize(UBound(arr) + 1) = Application.Transpose(arr)
 
Upvote 0
Thanks for your reply.
The sheet is "Sheet8" and range of data as A1:E15.

I tried it but giving error of type mismatch "run time error 13.". Can you please suggest why this error happening?
 
Last edited:
Upvote 0
Try it like this. If it still errors then which line and also what is the value of the variables i and j at the time

Code:
Dim table_arr, arr(), num1 As String, num2 As String, a As Long, mon_arr, i As Long, j As Long, sh As Worksheet

mon_arr = Array("Jan", 1, "Feb", 2, "Mar", 3, "Apr", 4, "May", 5, "Jun", 6, "Jul", 7, "Aug", 8, "Sep", 9, "Oct", 10, "Nov", 11, "Dec", 12)
Set sh = Sheets("Sheet8")
num1 = 100011
num2 = 2017
a = 0

With sh
    table_arr = .Range("A1:E15")
    .Range("F:F").ClearContents
    For i = 2 To UBound(table_arr, 1) Step 1
        For j = 2 To UBound(table_arr, 2) Step 1
            If Len(table_arr(i, j)) > 0 Then
                ReDim Preserve arr(0 To a)
                arr(a) = num1 & "," & table_arr(i, 1) & "," & num2 & "," & mon_arr(Application.Match(table_arr(1, j), mon_arr, 0)) & ",31," & table_arr(i, j)
                a = a + 1
                num1 = num1 + 1
            End If
        Next
    Next
    .Range("F1").Resize(UBound(arr) + 1) = Application.Transpose(arr)
End With
 
Upvote 0
Try it like this. If it still errors then which line and also what is the value of the variables i and j at the time

Code:
Dim table_arr, arr(), num1 As String, num2 As String, a As Long, mon_arr, i As Long, j As Long, sh As Worksheet

mon_arr = Array("Jan", 1, "Feb", 2, "Mar", 3, "Apr", 4, "May", 5, "Jun", 6, "Jul", 7, "Aug", 8, "Sep", 9, "Oct", 10, "Nov", 11, "Dec", 12)
Set sh = Sheets("Sheet8")
num1 = 100011
num2 = 2017
a = 0

With sh
    table_arr = .Range("A1:E15")
    .Range("F:F").ClearContents
    For i = 2 To UBound(table_arr, 1) Step 1
        For j = 2 To UBound(table_arr, 2) Step 1
            If Len(table_arr(i, j)) > 0 Then
                ReDim Preserve arr(0 To a)
                arr(a) = num1 & "," & table_arr(i, 1) & "," & num2 & "," & mon_arr(Application.Match(table_arr(1, j), mon_arr, 0)) & ",31," & table_arr(i, j)
                a = a + 1
                num1 = num1 + 1
            End If
        Next
    Next
    .Range("F1").Resize(UBound(arr) + 1) = Application.Transpose(arr)
End With

It worked perfectly, Thank you so much!!!!

can you please bit explain the statements you wrote? I want to learn please.

Thanks again!!
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,161
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top