Need concatenated data as

[rehanemis]

Hello,

I need the output from given information:

Here is the data information:

No	Mar	May	Sep	Dec
20	5	11	7
20				8
21	9	2
21			5	7

<tbody>
</tbody>

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?

 

[steve the fish]

VBA is very specific. How are we to know which range these values are in? Which sheet? Anyway this helps a little

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)

 

[rehanemis]

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?

 

[steve the fish]

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

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

 

[rehanemis]

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

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!!