Marco to move data and remove balnk rows

I have an excel spreadsheet which is the result of exporting data from a crystal report
The crystal report has data from a sub report and apparently the following exists
"The export to Excel is designed to export the subreport to the "next" row.  There is nothing you can do about that."

So is it possible to have a macro that puts the data under the correct headings and removes the blank rows
Have attached the excel file
Example the figures in row 3 should be in row 2 under the headings:-  Reg Hrs Qty      Reg Hrs Cost      O/T Hrs Qty      O/T Factor      OT Hrs Cost      Total Hrs Cost

Noting that some records do not contain data to move (example row 65)

Gordon
Test-Chargeable.xlsx
Gordon HughesDirectorAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
HI,

pls try
Sub macro()
Application.ScreenUpdating = False
Set Rng = Range(Range("A2"), Range("A" & Rows.Count))
For Each c In Rng.SpecialCells(xlCellTypeConstants, xlTextValues)
    c.Offset(1).Resize(1, 6).Copy c.Offset(, 12)
Next
Rng.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
NorieAnalyst Assistant Commented:
Try this, it puts the result on a new sheet.
Sub TransformChargeable()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long
Dim J As Long
Dim cnt As Long
    
    With Sheets("Sheet1")
     arrIn = .Range("A2", .Range("A" & Rows.Count).End(xlUp).Offset(, 11)).Value
    End With
    
    I = 1
    Do
        cnt = cnt + 1
        ReDim Preserve arrOut(1 To 18, 1 To cnt)
        
        For J = 1 To 12
            arrOut(J, cnt) = arrIn(I, J)
        Next J
        
        If arrIn(I + 1, 1) <> "" Then
            For J = 1 To 6
                arrOut(J + 12, cnt) = arrIn(I + 1, J)
            Next J
            I = I + 3
        Else
            I = I + 2
        End If
        
    Loop Until I > UBound(arrIn, 1)
    
    Sheets.Add
    
    ActiveSheet.Rows(1).Value = Sheets("Sheet1").Rows(1).Value
    
    ActiveSheet.Range("A2").Resize(UBound(arrOut, 2), UBound(arrOut, 1)).Value = Application.Transpose(arrOut)

End Sub

Open in new window

0
Gordon HughesDirectorAuthor Commented:
Hi Rgonzo1971

The macro seems to work well
How do I save it so that the macro can be seen and used where required on any excel spreadsheet
Gordon
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Gordon HughesDirectorAuthor Commented:
In principle I like the idea of saving the data in the format required in a new spreadsheet. the solution from Norie converts the date format from English to American format
But still don't know how to save the macro so that is accessible from any excel spreadsheet
Gordon
0
Rgonzo1971Commented:
by creating a PERSONAL.xlsb file you can put the macros to be used in all the worksheets

the PERSONAL.xlsb is opened whenever excel is opening

so create a dummy macro like in the link then put the my code in the created module
0
NorieAnalyst Assistant Commented:
Gordon

I didn't notice that about the date/times, I'll try and fix it and post back.
0
Gordon HughesDirectorAuthor Commented:
Ok am getting there can we fix the date format on the second solution?
Gordon
0
Gordon HughesDirectorAuthor Commented:
Thanks Norie
0
NorieAnalyst Assistant Commented:
Gordon

This should sort out the date problem and tidy things up a bit too.
Sub TransformChargeable()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long
Dim J As Long
Dim cnt As Long
    
    With Sheets("Sheet1")
        arrIn = .Range("A2", .Range("A" & Rows.Count).End(xlUp).Offset(, 11)).Value
    End With
    
    I = 1
    Do
        cnt = cnt + 1
        ReDim Preserve arrOut(1 To 18, 1 To cnt)
        
        For J = 1 To 12
        If J = 6 Or J = 7 Then
            arrOut(J, cnt) = DateValue(arrIn(I, J)) + TimeValue(arrIn(I, J))
        Else
            arrOut(J, cnt) = arrIn(I, J)
        End If
        Next J
        
        If arrIn(I + 1, 1) <> "" Then
            For J = 1 To 6
                arrOut(J + 12, cnt) = arrIn(I + 1, J)
            Next J
            I = I + 3
        Else
            I = I + 2
        End If
        
    Loop Until I > UBound(arrIn, 1)
    
    Sheets.Add
    
    With ActiveSheet
    
        With .Range("A2").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
            .Value = arrOut
            .Copy
        End With
    
        .Range("A20").PasteSpecial xlPasteValues, Transpose:=True
        .Range("2:19").Delete
        .Rows(1).Value = Sheets("Sheet1").Rows(1).Value
        .Range("F:G").NumberFormat = "dd/mm/yyyy hh:mm"
        .UsedRange.EntireColumn.AutoFit
        
    End With
    
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Gordon HughesDirectorAuthor Commented:
Hi Norie
All looks good now
Gordon
0
Gordon HughesDirectorAuthor Commented:
Thanks all
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.