PDA

View Full Version : Solved: Coverting table data to flat data & delete empty rows



ynui_boy
04-30-2008, 09:00 PM
I've managed to cobble together a maco that allows me to do the above conversion but I have minor problem. When the script starts to loop, the pasting of the new batch of data occurs way down the page. It looks as though it doesn't recognise that a bunch of rows were deleted on the previous pass. In the sample spreadsheet that I've attached, ten people's training records generated 164 records but, more importantly, excel appears to have processed 1489 rows to achieve it. I'd live with it if I only had a small number of people's records to convert, but I've got hundres (perhaps thousands) :wot

I'm sure that the script only requires a small tweak, but damned if I can find it. I have spent way too long try to nut it out, so I'm hoping you can assist.

Thanks

Ken Puls
04-30-2008, 10:44 PM
Hi there,

Rather than tweak your code, I actually re-wrote this. I believe that the output looks identical, but you should check it to be sure.

It will append the data to the next available row in Sheet2, (or row 2 if the sheet is blank, as it is expecting a header.)

Sub Convert()
Dim wsOld As Worksheet
Dim wsNew As Worksheet
Dim lSourceRow As Long
Dim lSourceCol As Long
Dim lSourceLastCol As Long
Dim lTargetRow As Long
Dim aryEmployee() As Variant

Application.ScreenUpdating = False

Set wsOld = Worksheets("Sheet1")
lSourceLastCol = wsOld.Range("A1").End(xlToRight).Column
Set wsNew = Worksheets("Sheet2")
lTargetRow = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1

For lSourceRow = 2 To wsOld.Cells(wsOld.Rows.Count, 1).End(xlUp).Row
aryEmployee = wsOld.Range(wsOld.Cells(lSourceRow, 1), wsOld.Cells(lSourceRow, 9))
For lSourceCol = 10 To lSourceLastCol
If Not wsOld.Cells(lSourceRow, lSourceCol) = vbNullString Then
With wsNew
.Range(.Cells(lTargetRow, 1), .Cells(lTargetRow, 9)) = aryEmployee
.Cells(lTargetRow, 10) = wsOld.Cells(1, lSourceCol).Value
.Cells(lTargetRow, 11) = wsOld.Cells(lSourceRow, lSourceCol).Value
End With
lTargetRow = lTargetRow + 1
End If
Next lSourceCol
Next lSourceRow

Application.ScreenUpdating = True
End Sub

I think you'll find that it runs a little faster too.

Btw... Welcome to VBAX. :)

ynui_boy
04-30-2008, 11:03 PM
Wow! Color me impressed. It works perfectly...
Thanks for your help Ken, you've saved me a ton of work.