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:

ABI001

ABI001

ABI001

ADA002

ADA002

ADA002

<tbody>
</tbody>

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

 

[wideboydixon]

I've tried to understand your requirements and I think this should do what you want but I don't have data to test it on so I can't be 100% sure. Give it a try and let me know.

Public Sub Copy_Paste_Loop()

Dim lastRow As Long
Dim thisRow 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
    ' 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
    
    ' 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
Next thisRow

End Sub

WBD

 

[Jeffreyxx01]

Thanks for your answer WBD,

The code actually copied the formulas in all the cells going down the worksheet,
I needed the code to copy K2:V2 in format formulas into the next unique code that the code find in column F

ABI001

ABI001

ABI001

ADA002

ADA002

ADA002

<tbody>
</tbody>

Like I have the formulas in K2:V2
and in my example the next code should be copied at the next unique code ADA002 and not everywhere, until there is no more unique code,
Hope this help?

 

[Jeffreyxx01]

Hi Again WBD,

Actually the code work for the unique value, it is perfect,
However the sum for each unique code in column J sometimes has only 1 line, then the code does not take it into account.
Do you know a way of making it happen when there is only 1 line ?

Best

 

[wideboydixon]

Hey. I did wonder about that. If there's only one line for a code (e.g. only one line with ABI001), what should it do? Copy the formulas from K2:V2 or put in the sum or some combination of both? I.e. what should be in column K in this case?

WBD

 

[Jeffreyxx01]

For example: Always copy K2:V2 to each unique code for pupil, this works great even with one line,

Though the sum thing does not work with one line only, it does not sum the cell in J into K but it does work when there is several lines,
I hope it helps to you

 

[wideboydixon]

Column K can't contain the copied formula *AND* the sum - which one should it be?

WBD

 

[Jeffreyxx01]

What about copy the formulas from L2:V2 (my formulas are there) and sum the column J for each unique code into the last K line ?

 

[wideboydixon]

Perhaps then just change the order of the update:

Public Sub Copy_Paste_Loop()

Dim lastRow As Long
Dim thisRow 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

End Sub

WBD

 

[Jeffreyxx01]

Thanks WBD,
it works well but can you tell me why it does not let me use a button click to work the macro without going into the developer tab?