Transform a table
 

Hi,

I get a rather oddly formatted report once a month that I would like to
transform in to something more readable. So far I have the following
VBA code that works until it hits an empty row. It then looses count
and the information gets random.
I would like the code to skip empty rows AND the header information
that appears every 64 rows.
The header information always starts with a blank row.

I believe it would work if I could get it to Step 8 rows when it hits a
blank row. Can any one help?

Sub Transform()
Const NEW_SHEET_NAME As String = "MyData"
Dim lLastRow As Long, lRow As Long
Dim ws As Worksheet
Dim aCells, i As Long
Dim rg As Range

Set ws = Sheets("Sheet1") '//source sheet
lLastRow = ws.Cells(ws.Rows.Count, "A").End(3).Row

'//stack relevant cells here
aCells = Array("A1", "A2", "C1", "E1", "E2")

With Sheets.Add '//target sheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets(NEW_SHEET_NAME).Delete
Application.DisplayAlerts = True
On Error GoTo 0
.Name = NEW_SHEET_NAME
'//make headers...
For i = LBound(aCells) To UBound(aCells)
.[A1].Offset(, i) = ws.Range(aCells(i))
Next i
'//...and loop through the data range and transform
If .Cells(.Rows.Count, "A") = " " Then
For lRow = 6 To lLastRow Step 8
Next
Else
For lRow = 6 To lLastRow Step 5
Set rg = ws.Cells(lRow, "A").Resize(5, 5)
With .Cells(.Rows.Count, "A").End(3)
For i = LBound(aCells) To UBound(aCells)
.Offset(1, i) = rg.Range(aCells(i))
Next i
End With
Next lRow
End If
End With
End Sub


Sample data;

Micro Date Micro Time Last Name
Personnel Type Department
Reader Description Employee Number
Transaction Type Logical Reader Type Badge In
Facility

0015-1-02 LL3 Comp Rm TrapComp Rm <<< Valid Data
<Blank row
1 LL3 Computer Rm Access October 06
2 <Blank row
3 Micro Date
4 Personnel Type
5 Reader Description
6 Transaction Type
7 Facility
Valid < Valid data

Transform a table
 

Hi,

I do not really understand the problem, but I know how to cope with blank
cells and stuff. For that you need a "While" like this one:

Option Explicit
Public Function f(first As Long) As Long
'first = the first row in which data-blocks start
Dim ws As Long
f = 0
ws = 1 'Suppose data is stored in worksheet 1
With Worksheets(ws)
'Here you can put any combination of data types _
and restrictions, so vbDouble is just an example.
Do While VarType(.Cells(first + f, 1)) = vbDouble
f = f + 1
Loop
End With
End Function

If in ws=1 you have
A1 = 1
A2 = 2
A3 = 3
A4 = 4
A5 = 5
f(1) = 5, f(2) = 4, and so on.

I think first you should calculate where the data-blocks are, and give it
some format after you know the dimensions of each block. Remember that
worksheets are big matrices and that each data block is a submatrix.

Good luck and hope this gives you some ideas!
--
Carlos


"OldDog" wrote:

Hi,

I get a rather oddly formatted report once a month that I would like to
transform in to something more readable. So far I have the following
VBA code that works until it hits an empty row. It then looses count
and the information gets random.
I would like the code to skip empty rows AND the header information
that appears every 64 rows.
The header information always starts with a blank row.

I believe it would work if I could get it to Step 8 rows when it hits a
blank row. Can any one help?

Sub Transform()
Const NEW_SHEET_NAME As String = "MyData"
Dim lLastRow As Long, lRow As Long
Dim ws As Worksheet
Dim aCells, i As Long
Dim rg As Range

Set ws = Sheets("Sheet1") '//source sheet
lLastRow = ws.Cells(ws.Rows.Count, "A").End(3).Row

'//stack relevant cells here
aCells = Array("A1", "A2", "C1", "E1", "E2")

With Sheets.Add '//target sheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets(NEW_SHEET_NAME).Delete
Application.DisplayAlerts = True
On Error GoTo 0
.Name = NEW_SHEET_NAME
'//make headers...
For i = LBound(aCells) To UBound(aCells)
.[A1].Offset(, i) = ws.Range(aCells(i))
Next i
'//...and loop through the data range and transform
If .Cells(.Rows.Count, "A") = " " Then
For lRow = 6 To lLastRow Step 8
Next
Else
For lRow = 6 To lLastRow Step 5
Set rg = ws.Cells(lRow, "A").Resize(5, 5)
With .Cells(.Rows.Count, "A").End(3)
For i = LBound(aCells) To UBound(aCells)
.Offset(1, i) = rg.Range(aCells(i))
Next i
End With
Next lRow
End If
End With
End Sub


Sample data;

Micro Date Micro Time Last Name
Personnel Type Department
Reader Description Employee Number
Transaction Type Logical Reader Type Badge In
Facility

0015-1-02 LL3 Comp Rm TrapComp Rm <<< Valid Data
<Blank row
1 LL3 Computer Rm Access October 06
2 <Blank row
3 Micro Date
4 Personnel Type
5 Reader Description
6 Transaction Type
7 Facility
Valid < Valid data