PDA

View Full Version : Solved: Disjointed Information to Table (Solved)



Xrull
06-22-2010, 05:41 PM
Good day everybody,

The accounting system I work with produces reports in Excel, but the data is easily manipulated.

In column A here are always 10 lines of data that represents a type of heading.

There is another set of headings that go from column B to O then there is an empty row, then that is followed by a block of data. This pattern repeats until it gets to the end of the worksheet.

It is very difficult to explain how the data is set up.

All I need to do is add 3 columns on the sheet named Fixed, and use the headings in the columns B to O on the Disjointed sheet and put those headings in columns D to P.

The sheet named Disjointed shows how the data looks when it is downloaded, and the sheet named fixed shows the data should look.

This is a cross post. I posted here yesterday, but I didn't get a reply:

http://www.excelforum.com/excel-programming/733957-disjointed-information-to-table.html

I'm trying to use the offset formula in P14, but I can't follow through:

=IF(OFFSET($O13,-1,-13)=" Sloc",OFFSET(O13,-10,-14),"")

I'd appreciate a VBA solution.

Thanks,
Xrull

Paul_Hossler
06-22-2010, 07:19 PM
Seems to work -- could stand some polishing


Option Explicit
Sub drv()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rData As Range
Dim iRow As Long
Application.ScreenUpdating = False
Set ws1 = ActiveSheet

Application.DisplayAlerts = False
On Error Resume Next
Worksheets(ws1.Name & "-Fixed").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Call ws1.Copy(, ws1)
Set ws2 = ActiveSheet
ws2.Name = ws1.Name & "-Fixed"
Set rData = ws2.UsedRange
Set rData = rData.Cells(14, rData.Columns.Count).Resize(rData.Rows.Count - 14, rData.Columns.Count)
With rData
.Columns("P:P").Formula = "=IF(OFFSET($O13,-1,-13)="" Sloc"",OFFSET(O13,-10,-14))"
.Columns("Q:Q").Formula = "=IF(OFFSET($O13,-1,-13)="" Sloc"",OFFSET(O13,-9,-14))"
.Columns("R:R").Formula = "=IF(OFFSET($O13,-1,-13)="" Sloc"",OFFSET(O13,-8,-14))"
Columns("P:R").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
End With


With ws2
.Columns(1).Delete

For iRow = .UsedRange.Rows.Count To 1 Step -1
If Len(.Cells(iRow, 2).Value) = 0 Then .Rows(iRow).Delete
Next iRow

For iRow = .UsedRange.Rows.Count To 2 Step -1
If .Cells(iRow, 2).Value = "MvT" Then .Rows(iRow).Delete
Next iRow

.Cells(1, 15).Value = "Val Ar"
.Cells(1, 16).Value = "Mat"
.Cells(1, 17).Value = "Desc"

For iRow = 2 To .Cells(1, 1).CurrentRegion.Rows.Count - 1
If Len(.Cells(iRow + 1, 15).Value) = 0 Then .Cells(iRow + 1, 15).Value = .Cells(iRow, 15).Value
If Len(.Cells(iRow + 1, 16).Value) = 0 Then .Cells(iRow + 1, 16).Value = .Cells(iRow, 16).Value
If Len(.Cells(iRow + 1, 17).Value) = 0 Then .Cells(iRow + 1, 17).Value = .Cells(iRow, 17).Value
Next iRow

.Columns("O:Q").Cut
.Columns("A:A").Select
Selection.Insert Shift:=xlToRight
.Columns("J:J").Delete Shift:=xlToLeft
End With

Application.ScreenUpdating = False
End Sub


Paul

Xrull
06-22-2010, 07:45 PM
Paul_Houssler,

This looks like the solution I am looking for.
I was running a lot of formulas and I watched the worksheet calculate, and calculate, and...you know what I mean.
I think I can say this one is solved.

Thanks,
Xrull

P.S.
I was using the Google Chrome browser, and it doesn't give the dropdown for the "Marked Solved" option. I had to come back to the forum using FireFox.