Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Transform table into calendar format | Excel Discussion (Misc queries) | |||
Transform csv to qif or ofx format? | Excel Discussion (Misc queries) | |||
Table Transform | Excel Discussion (Misc queries) | |||
Transform table | Excel Programming | |||
Transform. | Excel Programming |