Help need to find macro for copy and paste in transpose

[vinchel]

Hi,
I have a csv sheet which I have to convert into .xls report daily. Please suggest me a macro for the function. The action which I want to do is.



Execution Started 11/10/2011 0:07
URL http://www.nike.com/nikeos/p/nike/en_US/
BrowserType iexplore
SCREEN NAME DISPLAY TIME(in seconds) RESULT
Nike Home Page 16.358 PASS
Login Screen 1.531 PASS
Facebook Login Screen 4.391 PASS
Nike Registered User Screen 6.906 PASS
Execution Time 2.3 Minutes

Execution Started 11/10/2011 0:10
URL http://nikerunning.nike.com/nikeos/p/nikeplus/en_US/
BrowserType iexplore
SCREEN NAME DISPLAY TIME(in seconds) RESULT
Nike Home Page 11.828 PASS
Login Screen 0.797 PASS
Facebook Login Screen 14.562 PASS
Nike Registered User Screen 10.702 PASS
Execution Time 2.16 Minutes

Execution Started 11/10/2011 0:12
URL http://www.nike.com/nikeos/p/nikebasketball/en_US/?sitesrc=uslp
BrowserType iexplore
SCREEN NAME DISPLAY TIME(in seconds) RESULT
Nike Home Page 13.562 PASS
Login Screen 0.875 PASS
Facebook Login Screen 4.484 PASS
Nike Registered User Screen 6.203 PASS
Execution Time 2.4 Minutes



From this CSV file I need to copy the time for Nike home page,login screen, facebook login screen,nike registered user screen into the following form.


1 11/10/2011 0:07 Nike.com IE 16.358 1.531 4.391 6.906
2 11/10/2011 0:10 Nike Plus IE 11.828 0.797 14.562 10.702
3 11/10/2011 0:12 Nike Basketball IE 13.562 0.875 4.484 6.203


please help me

 

[Weaver]

This ought to help

It's not exactly what you're looking for as I couldn't determine your criteria for reducing the length of the URL, but it's close enough, I think.

Run the code on a copy of your data, it should make a new sheet called 'output' (you ought to be able to see how to change this if you need to) and parse all the output into it.

HTH

Sub dataParse()
    Dim src As Worksheet, dst As Worksheet
    Dim kf As String, fs, fa, dr As Long
    kf = "Execution Started"
    dr = 2
    Set src = ActiveSheet
    Set dst = Sheets.Add(after:=src)
    With dst
        .Name = "output"
        .Range("A1: G1") = Array(kf, "URL", "Browser", "Nike Home Page", "Login Screen", "Facebook Login Screen", "Nike Registered User Screen")
    End With

    Set fs = src.Cells.Find(what:=kf & "*")
    If Not fs Is Nothing Then
        fa = fs.Address
        Do
            With dst
                .Cells(dr, 1).Value = Trim(Replace(fs.Value, kf, ""))
                .Cells(dr, 2).Value = getWord(fs.Offset(1).Value, 2)
                .Cells(dr, 3).Value = getWord(fs.Offset(2).Value, 2)
                .Cells(dr, 4).Value = getWord(fs.Offset(4).Value, 4)
                .Cells(dr, 5).Value = getWord(fs.Offset(5).Value, 3)
                .Cells(dr, 6).Value = getWord(fs.Offset(6).Value, 4)
                .Cells(dr, 7).Value = getWord(fs.Offset(7).Value, 5)
            End With
            Set fs = src.Cells.FindNext(fs)
            dr = dr + 1
        Loop While fs.Address <> fa
    End If
    dst.Range("A1: G1").EntireColumn.AutoFit
End Sub

Function getWord(ByVal str As String, pos As Integer)
    getWord = Split(str, " ")(pos - 1)
End Function