code using loop

[Jeffreyxx01]

Hi all,

I started a code but I am not too sure how to finish it and I am stuck.

Sub Copy_Paste_Loop()

    Dim PrevPupilCode As String
    Dim currentline As Integer
    Dim currentPupilcode As String
    Dim Sht As Worksheet
    
    currentline = 2
    PrevPupilCode = "nothing"




Do While (currentline <= maxNumberOfLines)


    With currentPupilcode.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    If (currentPupilcode <> PrevPupilCode) Then
        Sheets("Report").Range("K2:V2").Copy
        
                
    End If


End Sub

I have hard coded data from A to J and I have created formula from K to V,
I have the unique code in column F, looks like this:

[TABLE="class: cms_table, width: 55"]
<tbody>[TR]
[TD]ABI001[/TD]
[/TR]
[TR]
[TD]ABI001[/TD]
[/TR]
[TR]
[TD]ABI001[/TD]
[/TR]
[TR]
[TD]ADA002[/TD]
[/TR]
[TR]
[TD]ADA002[/TD]
[/TR]
[TR]
[TD]ADA002[/TD]
[/TR]
</tbody>[/TABLE]

I want to be able to find the next unique code in column F, copy and paste the row K2:V2 at each new unique code,
Also I want to be able to create automatic sum of the column K at the end of the last unique code, so I want to sum the column J from first code ABI001 until the last one,

If anyone has an idea or need more explanation I can try explaining more.

Thanks a lot

 

[Jeffreyxx01]

Can we add one last thing in the macro?

Can we get column K to V sum ?
Like K2 until find last row K then sum , then do all the same for other column?

 

[wideboydixon]

Extra piece on the end:

Public Sub Copy_Paste_Loop()

Dim lastRow As Long
Dim thisRow As Long
Dim thisCol As Long
Dim firstRow As Long
Dim currentPupil As String

' Set up first row of data
firstRow = 0

' Find last row of data
lastRow = Cells(Rows.Count, "F").End(xlUp).Row

' Process all rows (assuming starting at 2 for a header row)
For thisRow = 2 To lastRow
    ' Change of pupil?
    If Cells(thisRow, "F").Value <> currentPupil Then
        ' Copy the formulas from K2:V2 on the Report sheet
        Sheets("Report").Range("K2:V2").Copy Destination:=Cells(thisRow, "K")
        
        ' Remember the current pupil now
        currentPupil = Cells(thisRow, "F").Value
        
        ' Record the first row for this pupil
        firstRow = thisRow
    End If

    ' Add in the sum if necessary
    If (Cells(thisRow + 1, "F").Value <> Cells(thisRow, "F").Value) And (firstRow <> 0) Then
        Cells(thisRow, "K").Formula = "=SUM(J" & firstRow & ":J" & thisRow & ")"
    End If
Next thisRow

' Now sum all columns
For thisCol = Range("K2").Column To Range("V2").Column
    Cells(lastRow + 1, thisCol).FormulaR1C1 = "=SUM(R2C:R" & lastRow & "C)"
Next thisCol

End Sub

WBD

 

[Jeffreyxx01]

Thanks for it WBD, it works very well,
However the button thing does not work, I do not know why

 

[Jeffreyxx01]

Actually the button work now, but why it does not work when I put the button on another worksheet?
is this something that has to be written in the code?

 

[wideboydixon]

The macro, as written, works on the active sheet. Your original code was written to work on the active sheet so I created something similar. If you want it to work regardless of which sheet you're on then it needs some re-work. Specifically, I'd need to know the name of the sheet where you want all these formulas etc. to be.

WBD

 

[Jeffreyxx01]

Thanks WBD, I Think I will keep it somewhere in the worksheet, works very well,
I will test it with new data next week and give you some feedback,
Thanks a lot