need macro

[FrankSit]

Hello, Anybody can help me on how to make a macro to modify the lay out of my worksheet as shown in Sheet1, to be like the one shown in "To be" sheet. This is the format of report from a database that can be
copied to clip board in excel. Each person has multifield downward, and each group has a blank row cell in excel. In "to be", I want the period total to the line of the name. So that I can use vlookup each person's donation for 2023 compared with 2024

Thank you for any help

Frank

 

[FrankSit]

Do you mean like this?

End Sub[/code]

Yes Fuji, That's what I mean, but it worked in sheet1, could you make the result sits in "to be" Sheet?, Also suppose there are 5000 lines that to be modified, Is it still work?, and because the result is ok, c an I change the name from Sub test to other name?

Thank you

 

[FrankSit]

With your workbook open press Alt+F11, find your workbook on the left as below then click any boxes like the blue one until they show '-' symbols then double-click each worksheet or module as marked red on the left & each time look for any code in the right hand window. The code should be in a 'Module' like below.

View attachment 123124

Thank you Peter, your explanation is very clear I will look into it again.

God bless,

Frank Situmorang

 

[Fuji]

Yes Fuji, That's what I mean, but it worked in sheet1, could you make the result sits in "to be" Sheet?, Also suppose there are 5000 lines that to be modified, Is it still work?, and because the result is ok, c an I change the name from Sub test to other name?

Thank you

It should output the result in "to be" Sheet.
Where is it outputting at your end?

500 rows should not be a problem, but if you got unwanted result, please post back with the details.
Yes, you can rename the procedure name as you want,

If the result is OK, then below is a simpler version without loop.

Sub test()
    Dim ws As Worksheet, x&, myNames, s$(2)
    Set ws = Sheets("to be")
    ws.[a1].CurrentRegion.ClearContents
    With Sheets("sheet1")
        x = .Evaluate(Replace("max(if(#<>"""",row(#)))", "#", .UsedRange.Address))
        With .Range("a2", .Range("f" & x))
            On Error Resume Next
            .Columns("a:c").SpecialCells(4).FormulaR1C1 = "=r[-1]c"
            On Error GoTo 0
            myNames = WorksheetFunction.Unique(.Columns(1))
            s(0) = .Columns("a").Address(True, True, , True)
            s(1) = .Columns("f").Address(True, True, , True)
        End With
    End With
    With Sheets("to be").[a1].Resize(UBound(myNames))
        .CurrentRegion.ClearContents
        .Value = myNames
        .Columns(2).Formula = "=sumif(" & s(0) & ",a1," & s(1) & ")"
    End With
End Sub