chosen
New Member
- Joined
- Oct 3, 2022
- Messages
- 16
- Office Version
- 2021
- Platform
- Windows
I apologize in advance because I use google translate
I was doing a macro with the help of chatgpt
The macro will work on visible cells only on both "Page1" and "Page2".
Macro also works on shaded cells on "Page 2".
Page 2 consists of two columns, one with names and one with total installments, excluding any hidden columns. The macro will be triggered when a group of cells in these two columns is selected.
Conditionally, if the sum of the installments in the selected group of cells on "Page2" is equal to 0, the macro will move to the other cell. If the sum of the installments is greater than 0, the macro will look for the name in "Column Q" on "Page1".
If the name is found in "Column Q" on "Page1", the macro will proceed with additional conditions:
Condition 3: If the value in "Cell R" corresponding to the name (the result of the first condition) on "Page1" is greater than the sum of the installments, the macro will write the sum of the premiums in the first "Column" AC" cell corresponding to the name (the result of the first condition).
Condition 4: If the value in "Cell R" corresponding to the name (the result of the first condition) on "Page1" is less than the sum of the installments, the macro will write the value in "Cell R" in the first "Column AC" cell. Then, it will subtract the sum of the premiums in "Cell R" from the first result and call the remaining "Remainder 1". The macro will then compare "Remainder 1" with "Cell R" of the second result. If "Cell R" corresponding to the name (the result of the second condition) is greater than "Remainder 1", the macro will write "Remainder 1" in the second "Column AC" cell corresponding to the name (the result of the second condition). But if "Cell R" corresponding to the name (the result of the second condition) is smaller than "Remainder 1", the macro will write "Cell R" in the second "Column AC" cell. The macro will then subtract "Remainder 1" from "Cell R" of the second result and call the remainder "Remainder 2". This process will continue until the remainder reaches 0.
The result was this macro but it didn't work for me at all
Sub UpdateInstallments()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim selectedRange As Range, cell As Range
Dim sumInstallments As Double, name As String
Dim foundName As Range, remainder As Double
Set ws1 = Worksheets("sh1")
Set ws2 = Worksheets("sh2")
Set selectedRange = ws2.Selection.SpecialCells(xlCellTypeVisible)
For each cell In selectedRange
If cell. Column = 1 Then
name = cell. Value
sumInstallments = cell. Offset(0, 1). Value
If sumInstallments > 0 Then
Set foundName = ws1.Range("Q:Q").Find(name, LookIn:=xlValues, LookAt:=xlWhole)
While Not foundName Is Nothing And sumInstallments > 0
remainder = WorksheetFunction.Min(ws1.Cells(foundName.Row, "R").Value, sumInstallments)
ws1. Cells(foundName. Row, "AC"). Value = remainder
sumInstallments = sumInstallments - remainder
Set foundName = ws1.Range("Q:Q").Find(name, foundName, LookIn:=xlValues, LookAt:=xlWhole)
Wend
End If
End If
Next cell
End Sub
I was doing a macro with the help of chatgpt
The macro will work on visible cells only on both "Page1" and "Page2".
Macro also works on shaded cells on "Page 2".
Page 2 consists of two columns, one with names and one with total installments, excluding any hidden columns. The macro will be triggered when a group of cells in these two columns is selected.
Conditionally, if the sum of the installments in the selected group of cells on "Page2" is equal to 0, the macro will move to the other cell. If the sum of the installments is greater than 0, the macro will look for the name in "Column Q" on "Page1".
If the name is found in "Column Q" on "Page1", the macro will proceed with additional conditions:
Condition 3: If the value in "Cell R" corresponding to the name (the result of the first condition) on "Page1" is greater than the sum of the installments, the macro will write the sum of the premiums in the first "Column" AC" cell corresponding to the name (the result of the first condition).
Condition 4: If the value in "Cell R" corresponding to the name (the result of the first condition) on "Page1" is less than the sum of the installments, the macro will write the value in "Cell R" in the first "Column AC" cell. Then, it will subtract the sum of the premiums in "Cell R" from the first result and call the remaining "Remainder 1". The macro will then compare "Remainder 1" with "Cell R" of the second result. If "Cell R" corresponding to the name (the result of the second condition) is greater than "Remainder 1", the macro will write "Remainder 1" in the second "Column AC" cell corresponding to the name (the result of the second condition). But if "Cell R" corresponding to the name (the result of the second condition) is smaller than "Remainder 1", the macro will write "Cell R" in the second "Column AC" cell. The macro will then subtract "Remainder 1" from "Cell R" of the second result and call the remainder "Remainder 2". This process will continue until the remainder reaches 0.
The result was this macro but it didn't work for me at all
Sub UpdateInstallments()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim selectedRange As Range, cell As Range
Dim sumInstallments As Double, name As String
Dim foundName As Range, remainder As Double
Set ws1 = Worksheets("sh1")
Set ws2 = Worksheets("sh2")
Set selectedRange = ws2.Selection.SpecialCells(xlCellTypeVisible)
For each cell In selectedRange
If cell. Column = 1 Then
name = cell. Value
sumInstallments = cell. Offset(0, 1). Value
If sumInstallments > 0 Then
Set foundName = ws1.Range("Q:Q").Find(name, LookIn:=xlValues, LookAt:=xlWhole)
While Not foundName Is Nothing And sumInstallments > 0
remainder = WorksheetFunction.Min(ws1.Cells(foundName.Row, "R").Value, sumInstallments)
ws1. Cells(foundName. Row, "AC"). Value = remainder
sumInstallments = sumInstallments - remainder
Set foundName = ws1.Range("Q:Q").Find(name, foundName, LookIn:=xlValues, LookAt:=xlWhole)
Wend
End If
End If
Next cell
End Sub