Populate data in specific way .. complicated

[KingTamo]

Hi,

I'm after a vba code to convert data like in the attached excel file.
The data is to be converted is in the right hand side of the Input Data sheet and the results are on the left hand side.
One line of data can have various lines of results depending on the input data.

Each cell in the data row between cloumns Q and T would create a new line of output data.
A value in column U would create 2 lines of output data, one with a Type code of JC and one with a type code of JD.

if there is a date in the Pay Date Column then an extra row is created on the results side

The nominal AC Reference its taken from cells R2 to V2 EXCEPT for The nominal reference for Gross Pay...
If the name is M Rafiq then the nominal reference is 7000 and for any other name it is 7025.

I have put in 4 examples of data and results.
I would like the results to be sent to sheet "Wages to Import"

Ok.
When doing conversion first cell to check O2. If value = M Rafiq then use last 2 digits from Q2 for cell A2. Use first 4 digits in Q2 for cell c2.
If o4<> M Rafiq then use Q3.

Now we get data from yellow area.
First work in column Q

Date in column D2 =last Eight digits of P4
E2=o4
F2= o4+q1+d2
g2=q4
columns H and I are always T9 and 0.00
j2=first 3 digits of p4
k2 is always raf

If r4 is empty then goto work on column S
If s4 is empty then goto work on column T

A3=last 2 digits from t2
C3=first 4 digits from t2

etc....

For the last example where there is data in column U7 "Employer NIC" then the the last 2 digits from U2 are used for A15 and the first 4 digits for C15 etc. but then it is repeated on the next line but using the codes from S2 for A16 and C16.

Data in Column Q= 1 Line of output
Data in Column R= 1 Line of output
Data in Column S= 1 Line of output
Data in Column T= 1 Line of output
Data in Column U= 2 Lines of output
Data in Column V= 0 Lines of output
Data in Column W= 1 Line of output

I appreciate your help a lot

[KingTamo]

any help please

[KingTamo]

Is everything clear in my first post?

[KingTamo]

Can anyone help me please?

[YasserKhalil]

If you need to solve any problem try to divide your request into small issues .. Focus on one part in each thread

[KingTamo]

thanks for reply but it is only one issue and I need to solve it as a whole

[bulina2k]

how about N Bibi M03 05/07/15 400
this also has 3 rows!! and it is in Q column!
? am i missing something?

[bulina2k]

oh.. i guess it's a mistake on your results table... after the first 400 should be 279,87 twice right?

[bulina2k]

Hope it helps!
Open the file and press the button.

This is the code I wrote:

Sub not_so_complicated()

Dim val As Range, row As Range, q As String
Dim wsInput As Worksheet, lr As Long
Set wsInput = Sheets("Input Data")
With wsInput

    For Each row In .Range("Q4:Q" & .Range("P10000").End(xlUp).row)
        For Each val In Range(row, row.Offset(, 4))
            If Trim(val) <> "" Then
                lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                If val.Column = 17 Then        ''Column "Q"
                    If val.Offset(, -2) = "M Rafiq" Then q = .Range("Q2") Else q = .Range("Q3")
                Else
                    q = .Cells(2, val.Column)
                End If
                    
                .Range("A" & lr) = Right(q, 2)
                .Range("C" & lr) = Left(q, 4)
                .Range("D" & lr) = CDate(Right(.Range("P" & val.row), 8))
                .Range("E" & lr) = .Range("O" & val.row)
                .Range("F" & lr) = .Range("O" & val.row) & " " & .Cells(1, val.Column) & " " & CDate(Right(.Range("P" & val.row), 8))
                .Range("G" & lr) = val
                .Range("H" & lr) = "T9"
                .Range("I" & lr) = Format(0, "0.00")
                .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                .Range("K" & lr) = "raf"
                If val.Column = 20 And .Cells(val.row, "W") <> "" Then        ''Column "T"
                    lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                    q = .Range("V2")
                    .Range("A" & lr) = Right(q, 2)
                    .Range("C" & lr) = Left(q, 4)
                    .Range("D" & lr) = CDate(.Range("W" & val.row))
                    .Range("E" & lr) = .Range("O" & val.row)
                    .Range("F" & lr) = .Range("O" & val.row) & " Wage Payment " & CDate(Right(.Range("P" & val.row), 8))
                    .Range("G" & lr) = val
                    .Range("H" & lr) = "T9"
                    .Range("I" & lr) = Format(0, "0.00")
                    .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                    .Range("K" & lr) = "raf"
                
                ElseIf val.Column = 21 Then
                    lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                    q = .Range("S2")
                    .Range("A" & lr) = Right(q, 2)
                    .Range("C" & lr) = Left(q, 4)
                    .Range("D" & lr) = CDate(Right(.Range("P" & val.row), 8))
                    .Range("E" & lr) = .Range("O" & val.row)
                    .Range("F" & lr) = .Range("O" & val.row) & " " & .Cells(1, val.Column) & " " & CDate(Right(.Range("P" & val.row), 8))
                    .Range("G" & lr) = val
                    .Range("H" & lr) = "T9"
                    .Range("I" & lr) = Format(0, "0.00")
                    .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                    .Range("K" & lr) = "raf"
                
                End If
            End If
        Next val
    Next row
End With
End Sub

[KingTamo]

That's great
Actually I missed out a figure on the right hand side for N Bibi who had a deduction for child tax. In cell S6 should be 120.13.
For each month the sum of the values of JC figures should always equal JD figures.
Also the bank code from column V needs adding to the relevant cells in the results and for some reason the BP row does not come last for results of S Stead, otherwise looking good.

[bulina2k]

Actually I missed out a figure on the right hand side for N Bibi who had a deduction for child tax. In cell S6 should be 120.13

that is not a problem... just add the value to the correct place and run the code again.

... for some reason the BP row does not come last for results of S Stead...

the code treats the values not the names, that means that for each value in the right it writes 1 or 2 lines and passes to another value.

[KingTamo]

Yes I have added the value. Only need the BP codes need adding and could you take a look at why the BP row for S Stead is coming in the wrong place?
I have added .Range("B" & lr) = Range("V" & val.row) and now BP code is showing.Is this ok?

[bulina2k]

Yes your addition is good. I have modified the code to put the lines created by U-column before the BP line.

please copy and replace :

Sub not_so_complicated()

Dim val As Range, row As Range, q As String
Dim wsInput As Worksheet, lr As Long
Set wsInput = Sheets("Input Data")
With wsInput

    For Each row In .Range("Q4:Q" & .Range("P10000").End(xlUp).row)
        For Each val In Range(row, row.Offset(, 4))
            If Trim(val) <> "" Then
                lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                If val.Column = 17 Then        ''Column "Q"
                    If val.Offset(, -2) = "M Rafiq" Then q = .Range("Q2") Else q = .Range("Q3")
                Else
                    q = .Cells(2, val.Column)
                End If
                If val.Column = 21 Then
                    .Range("A" & lr - 1 & ":K" & lr - 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                lr = lr - 1
                
                End If
                
                .Range("A" & lr) = Right(q, 2)
                .Range("C" & lr) = Left(q, 4)
                .Range("D" & lr) = CDate(Right(.Range("P" & val.row), 8))
                .Range("E" & lr) = .Range("O" & val.row)
                .Range("F" & lr) = .Range("O" & val.row) & " " & .Cells(1, val.Column) & " " & CDate(Right(.Range("P" & val.row), 8))
                .Range("G" & lr) = val
                .Range("H" & lr) = "T9"
                .Range("I" & lr) = Format(0, "0.00")
                .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                .Range("K" & lr) = "raf"
                If val.Column = 20 And .Cells(val.row, "W") <> "" Then        ''Column "T"
                    lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                    q = .Range("V2")
                    .Range("A" & lr) = Right(q, 2)
                    .Range("B" & lr) = .Range("V" & val.row)
                    .Range("C" & lr) = Left(q, 4)
                    .Range("D" & lr) = CDate(.Range("W" & val.row))
                    .Range("E" & lr) = .Range("O" & val.row)
                    .Range("F" & lr) = .Range("O" & val.row) & " Wage Payment " & CDate(Right(.Range("P" & val.row), 8))
                    .Range("G" & lr) = val
                    .Range("H" & lr) = "T9"
                    .Range("I" & lr) = Format(0, "0.00")
                    .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                    .Range("K" & lr) = "raf"
                
                ElseIf val.Column = 21 Then
                    lr = lr + 1
                    .Range("A" & lr & ":K" & lr).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    q = .Range("S2")
                    .Range("A" & lr) = Right(q, 2)
                    .Range("C" & lr) = Left(q, 4)
                    .Range("D" & lr) = CDate(Right(.Range("P" & val.row), 8))
                    .Range("E" & lr) = .Range("O" & val.row)
                    .Range("F" & lr) = .Range("O" & val.row) & " " & .Cells(1, val.Column) & " " & CDate(Right(.Range("P" & val.row), 8))
                    .Range("G" & lr) = val
                    .Range("H" & lr) = "T9"
                    .Range("I" & lr) = Format(0, "0.00")
                    .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                    .Range("K" & lr) = "raf"
                
                End If
            End If
        Next val
    Next row
End With
End Sub

[KingTamo]

Thanks a lot for help.
I have now tried it with real data. All working ok except a minor overlook on my behalf.
Sometimes the P.A.Y. in column R can be a negative, but results can not have a negative value in them. Instead the negative is turned into a positive value and the code for column A is reversed (JD instead of JC).

BTW the codes in the green box should have been. I'v corrected these on my sheet.

7000-JD 2210-JC 2211-JC 2220-JC 7050-JD 2220-BP
7025-JD

[bulina2k]

here :

Sub not_so_complicated()

Dim val As Range, row As Range, q As String
Dim wsInput As Worksheet, lr As Long
Set wsInput = Sheets("Input Data")
With wsInput

    For Each row In .Range("Q4:Q" & .Range("P10000").End(xlUp).row)
        For Each val In Range(row, row.Offset(, 4))
            If Trim(val) <> "" Then
                lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                If val.Column = 17 Then                  ''''''''''''''Column "Q"
                    If val.Offset(, -2) = "M Rafiq" Then q = .Range("Q2") Else q = .Range("Q3")
                Else
                    q = .Cells(2, val.Column)
                End If
                If val.Column = 21 Then
                    .Range("A" & lr - 1 & ":K" & lr - 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                lr = lr - 1
                
                End If
                
                .Range("A" & lr) = Right(q, 2)
                .Range("C" & lr) = Left(q, 4)
                .Range("D" & lr) = CDate(Right(.Range("P" & val.row), 8))
                .Range("E" & lr) = .Range("O" & val.row)
                .Range("F" & lr) = .Range("O" & val.row) & " " & .Cells(1, val.Column) & " " & CDate(Right(.Range("P" & val.row), 8))
                If val < 0 Then
                    .Range("A" & lr) = "JD"
                End If
                .Range("G" & lr) = Abs(val)
                .Range("H" & lr) = "T9"
                .Range("I" & lr) = Format(0, "0.00")
                .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                .Range("K" & lr) = "raf"
                If val.Column = 20 And .Cells(val.row, "W") <> "" Then        ''Column "T"
                    lr = .Cells(.Rows.Count, "A").End(xlUp).row + 1
                    q = .Range("V2")
                    .Range("A" & lr) = Right(q, 2)
                    .Range("B" & lr) = .Range("V" & val.row)
                    .Range("C" & lr) = Left(q, 4)
                    .Range("D" & lr) = CDate(.Range("W" & val.row))
                    .Range("E" & lr) = .Range("O" & val.row)
                    .Range("F" & lr) = .Range("O" & val.row) & " Wage Payment " & CDate(Right(.Range("P" & val.row), 8))
                    .Range("G" & lr) = val
                    .Range("H" & lr) = "T9"
                    .Range("I" & lr) = Format(0, "0.00")
                    .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                    .Range("K" & lr) = "raf"
                
                ElseIf val.Column = 21 Then
                    lr = lr + 1
                    .Range("A" & lr & ":K" & lr).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    q = .Range("S2")
                    .Range("A" & lr) = Right(q, 2)
                    .Range("C" & lr) = Left(q, 4)
                    .Range("D" & lr) = CDate(Right(.Range("P" & val.row), 8))
                    .Range("E" & lr) = .Range("O" & val.row)
                    .Range("F" & lr) = .Range("O" & val.row) & " " & .Cells(1, val.Column) & " " & CDate(Right(.Range("P" & val.row), 8))
                    .Range("G" & lr) = val
                    .Range("H" & lr) = "T9"
                    .Range("I" & lr) = Format(0, "0.00")
                    .Range("J" & lr) = Left(.Range("P" & val.row), 3)
                    .Range("K" & lr) = "raf"
                
                End If
            End If
        Next val
    Next row
End With
End Sub

[KingTamo]

Sorry for my late response
That's great job. Thank you very much for helping me
thanks a million

[bulina2k]

You're welcome! Thank you for the rep.