PDA

View Full Version : Solved: Writing one row to many rows depending of contents in column



PerS
12-02-2008, 06:49 AM
Hi

I receive spreadsheets from different departments with time-data and I need to transform them into data that fits in our payroll system. The input looks like this:

1825 abc 3001 17,5 3,5 3,83 0
2653 def 3001 69 21 5,75 7
1883 hij 3001 33,75 2 4,25 4,5

where column A = Employee no, B = Name, C = Department, D = Normal Hours, E = Evening Hours, F = Saturday and G = Sunday Hours.

I want to copy the data into a new worksheet "Sheet2" in this format:
1825 Normal 17,5 3001
1825 Evening 3,5 3001
1825 Saturday 3,83 3001
2653 Normal 69 3001
2653 Evening 21 3001
2653 Saturday 5,75 3001
2653 Sunday 7 3001
1883 Normal 33,75 3001
1883 Evening 2 3001
1883 Saturday 4,25 3001
1883 Sunday 4,5 3001

where column A = Employee no, B = Type of hour, C = No of Hours, D to H = blanks and I = Department.

Row 1 gives new 3 rows (0 hours is not written in the output), row 2 and 3 gives 4 new rows.

How do I solve this problem ?

Bob Phillips
12-02-2008, 07:24 AM
Public Sub ProcessData()
Dim i As Long, j As Long
Dim LastRow As Long
Dim aryTypes As Variant

Application.ScreenUpdating = False

With ActiveSheet

aryTypes = Array("Normal", "Evening", "Saturday", "Sunday")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1

For j = 7 To 4 Step -1

If .Cells(i, j).Value <> 0 Then

.Rows(i + 1).Insert
.Cells(i, "A").Copy .Cells(i + 1, "A")
.Cells(i + 1, "B").Value = aryTypes(j - 4)
.Cells(i + 1, "C").Value = .Cells(i, j).Value
.Cells(i + 1, "D").Value = .Cells(i, "C").Value
End If
Next j
.Rows(i).Delete
Next i
.Columns("E:G").ClearContents
End With

Application.ScreenUpdating = True

End Sub

PerS
12-02-2008, 07:50 AM
Great. :hifive: You are quick. Just what I needed. That ill save us a lot of time copy/pasting.
The only thing I could ask for now is that I want to place the result in an other worksheet(Sheet2) so I have both input and output in the same spreadsheet (there are controlfreaks out there...).

Bob Phillips
12-02-2008, 08:36 AM
I wished you had saiud that at the start, that is easier :)



Public Sub ProcessData()
Dim i As Long, j As Long
Dim LastRow As Long
Dim NextRow As Long
Dim aryTypes As Variant
Dim sh As Worksheet
Dim this As Worksheet

Set this = ActiveSheet

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Results").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set sh = Worksheets.Add
sh.Name = "Results"

Application.ScreenUpdating = False

With this

aryTypes = Array("Normal", "Evening", "Saturday", "Sunday")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow

For j = 4 To 7

If .Cells(i, j).Value <> 0 Then

NextRow = NextRow + 1
.Cells(i, "A").Copy sh.Cells(NextRow, "A")
sh.Cells(NextRow, "B").Value = aryTypes(j - 4)
sh.Cells(NextRow, "C").Value = .Cells(i, j).Value
sh.Cells(NextRow, "D").Value = .Cells(i, "C").Value
End If
Next j
Next i
End With

Application.ScreenUpdating = True

End Sub

PerS
12-03-2008, 08:33 AM
Hi xld

Thanks for the new code. Works as I had hoped.
If you ever come to Copenhagen I'll give a beer in the Tivoli Garden.

ps. I did write "I want to copy the data into a new worksheet "Sheet2" in this format:" in my first question ;-)

Bob Phillips
12-03-2008, 08:39 AM
ps. I did write "I want to copy the data into a new worksheet "Sheet2" in this format:" in my first question ;-)

So you did, but I was only teasing anyway!