Transform a table

[OldDog]

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 Trap>Comp 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

 

[Guest]

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

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 Trap>Comp 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

 

[OldDog]

Thanks Carlos;

I found that I need to clean up the data before I do the transform.
I am still haveing some issues.

Here is my CleanUp code so far;

<--------------------------Start Code------------->
Sub CleanUp()
Dim lRow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim ws1 As Worksheet
Set ws1 = ActiveSheet

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With ws1
.DisplayPageBreaks = False
StartRow = 6
EndRow = 7000

For lRow = StartRow To EndRow Step 1
If IsError(.Cells(lRow, "A").Value) Then
'Do nothing, This avoid a error if there is a error in the cell
ElseIf .Cells(lRow, "A").Value = 0 Or _
.Cells(lRow, "A").Value = "Micro Date" Or _
.Cells(lRow, "A").Value = "Personnel Type" Or _
.Cells(lRow, "A").Value = "Reader Description" Or _
.Cells(lRow, "A").Value = "Transaction Type" Or _
.Cells(lRow, "A").Value = "Facility" Or _
.Cells(lRow, "A").Value = "LL3 Computer Rm Access October 06"
Then
.Rows(lRow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub
'<------------------------------End Code------------>

It skips "Personnel Type" for some reason And how do I set it so that
it will read part of a string? I would like to use InStr(.Cells(lRow,
"A").Value, Computer Rm Access) so that I don't have to worry about the
date.

OldDog

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

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 Trap>Comp 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