Transpose data from a excel template in a line wise

**itsmesunilb** · 09-02-2012, 02:53 AM

Hi,

I have data in a table form in excel template which I want to capture line wise so that I can do further analysis on the data.
I would like to generate a simple template which could help me with all the details in a tablular form so that I can use this info for further analysis.

In the attached file, there is a sheet titled "Input" which has the details of the Managers visiting their partners in a particular state. There are about 30 such states with around 350 managers reporting on daily basis.

Required data sample is given in the "summary" tab in the attached sheet. Look forward to your help on the concern at earliest.
Thanks

**oeldere** · 09-02-2012, 04:43 AM

I you are able to re-arange your data, you can use pivot table for that.

**itsmesunilb** · 09-02-2012, 05:34 AM

Pivot table is not the option. There would be more than 30 similar templates that I would be receiving every day and rearranging data ( currently doing so) would again be tedious task. I would like to have simple solution may be in VB or through some formulea...

rearranging at the moment is taking lot of time...please assist with some automation around the same...thanks

**mike7952** · 09-02-2012, 08:20 AM

Give this a try

Sub abc()
 Dim LastRow As Long, pos As Long, i As Long, ii As Long, iii As Long, n As Long
 Dim a() As Variant
 Dim State As String, s As String
 Dim iDate As Date
 
 State = Cells(2, "D")
 iDate = Cells(3, "D")
 LastRow = Cells(Rows.CountLarge, "C").End(xlUp).Row
 
 ReDim a(1 To LastRow, 1 To 14)
 For i = 6 To LastRow
    If InStr(1, Cells(i, "C"), "Manager Name:", vbTextCompare) > 0 Then
        pos = InStr(1, Cells(i, "C"), "Manager Name:", vbTextCompare)
        pos = pos + Len("Manager Name:")
        s = Mid$(Cells(i, "C"), pos, Len(Cells(i, "C")) - pos + 1)
    End If
    If InStr(1, Cells(i, "C"), "Partner", vbTextCompare) > 0 Then
            ii = i + 1
            Do
                n = n + 1
                a(n, 1) = State
                a(n, 2) = iDate
                a(n, 3) = s
                For iii = 3 To 13
                    a(n, iii + 1) = Cells(ii, iii)
                Next iii
            ii = ii + 1
            Loop Until Len(Cells(ii, "C")) = 0
    End If
 Next i
 Worksheets("SUMMARY").Range("b5").Resize(n, 14) = a
End Sub

**itsmesunilb** · 09-02-2012, 12:59 PM

Thanks a ton..it did worked!! I need one change in this...If my columns get increased from current 11 to 15 in input sheet, what part of the code need to be changed? If you could help me with this, it would be great..!!

---------- Post added at 10:29 PM ---------- Previous post was at 10:23 PM ----------

Mike,

I did some trial & error on the code and it is working as per my requirement now. Thanks a ton.