Format Importet Data from Web in Excel 2003/2007

[frankki]

Hi Champs

I am using a Data Connection to fetch Data from the following URL into Excel, starting in A2:

http://www.microsoft.com/downloads/...0DA-4438-AC6A-4FB24E54A466&sortCriteria=title

--> I need to strip the first line of the importet Data
--> Delete the last coloumn
--> Move the "text" part into the same line as the "title"
--> strip the url behind the title to a visible URL and copy that url in the same line with the title & body
--> display the title as text only


So It should look like this after all is done:

A1-D1 HeaderRow
A1 = Title (Text)
B1 = Body (RichText possible here? Otherwise txt)
C1 = URL (URL)
D1 = ReleaseDate


Is that possible at all???

Also:
When I refresh the data, will the already available data being deletet or just "enhanced" by new data?

Reason for doing this, is creating a internal webfeed in MOSS 2007 for better information gathering/sharing.
I do not want to import the data from MOSS directly and got to use Excel, Access or Winword 2003 or 2007 versions.

Any help is much appreciated.

 

[SkipVought]

Hi,

Turn on your macro recorder and...

--> I need to strip the first line of the importet Data
--> Delete the last coloumn
--> Move the "text" part into the same line as the "title"
--> strip the url behind the title to a visible URL and copy that url in the same line with the title & body
--> display the title as text only

Post back with your recorded code is you need help.

Skip,

_[red][/red]

 

[frankki]

Grmpf...
I tried that already.
Problem is: Amount of topics do differ from time to time I need to run the makro.

So I need a "loop" for the copy/paste operation that "simply" takes every second row from a specific start point and move that one next to the related title. But then the counter is not valid anymore, because the active cell now is different. So I thought it might makes sense to check for non URL encoded text by row and move that content as specified, looping through the sheet(s).

Then I cant record the URL path, as I cannot access the "Hyperlink" by right clicking on it while in recoding mode, neither can I copy/paste the hyperlink

Any more smart ideas than using the recorder are much appreciated...

Thanks

 

[SkipVought]

Grmpf... dispite your perceived problems, the afore mentioned step is an essential part if the process that we are in.




Waiting for your code......................

Skip,

_[red][/red]

 

[SkipVought]

BTW, what table are you referencing in you query?

Skip,

_[red][/red]

 

[frankki]

Hi

Just saw that the import isnt really working as some links gets broken = no link = thing dont work

However, my "code" would have beens something like this (and would have required a lot improvements ...), especially as the move last column thing doesnt work at all if run in the macro, if run standalone it does... strange...

Sub DeleteLastColumn()

' Delete Last Coloumn
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
End Sub

Sub MoveLastColumn()

' Move Date to last Coloumn
Columns("B:B").Select
Selection.Cut
Columns("D").Select
End Sub
Sub FormatImportetData()

' Call DeleteLastColumn
Application.Run "Book1!DeleteLastColumn"
Application.CutCopyMode = True

' Call MoveLastColumn
Application.Run "Book1!MoveLastColumn"
Application.CutCopyMode = True

'Delete Imported HeaderRow
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp

' Copy Body to same line as belonging title

' CleanUpFormatting
Cells.Select
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Verdana"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Locked = False
Selection.FormulaHidden = False
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit

End Sub

 

[SkipVought]

I STRONLY advise against using the Select and Activate methods to reference in code. It slows things down.

This code FINDS the last column for you, as it seems this may vary...

Sub DeleteLastColumn()

' Delete Last Coloumn
    Cells(2, "IV").End(xlToLeft).EntireColumn.Delete shift:=xlToLeft
End Sub

Sub MoveLastColumn()

' Move Date to last Coloumn
    Columns("B:B").Cut
    Cells(2, "IV").End(xlToLeft).Offset(-1, 1).Insert shift:=xlToRight
End Sub
Sub FormatImportetData()

' Call DeleteLastColumn
    Application.Run "Book1!DeleteLastColumn"
    Application.CutCopyMode = True
    
' Call MoveLastColumn
    Application.Run "Book1!MoveLastColumn"
    Application.CutCopyMode = True

'Delete Imported HeaderRow

'THIS IS A BAD PRACTICE to use SELECTIONS.  Reference the cell EXPLICITLY!!!
 '''   ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Cells(3, 1).EntireRow.Delete shift:=xlUp
'    Rows("2:2").Select
'    Selection.Delete shift:=xlUp

' Copy Body to same line as belonging title

' CleanUpFormatting
    With Cells
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        With .Font
            .Name = "Verdana"
            .FontStyle = "Standard"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        .Locked = False
        .FormulaHidden = False
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With

End Sub

Skip,

_[red][/red]