In Excel, I need to check for percents >0 and <100 in multiple columns, insert a new row with copied data from that row, and modify both rows. If this occurs in--for example--Row 27, I need to copy Row 27 and insert the copied row before Row 28, while changing the percents in both rows and also an amount from a different column. The percent data is in columns X through AG, and the amount data is in column AH. Example:

Row 27: Column X (40%) ... Column AD (60%) ... Column AH ($10,000)This needs to become as follows:

Row 27: Column X (100%) ... Column AD (0%) ... Column AH ($4,000)

Row 28*: Column X (0%) ... Column AD (100%) ... Column AH ($6,000)

*Inserted by the macroHopefully this makes sense. Can anyone help?

In case it was unclear, I want everything in Row 28 to be identical to that in Row 27 (values, formulas, etc)--EXCEPT for the modified columns (percents/amounts). Thanks!

Maybe another way to do this would be to add multiple new rows (one for each % > 0 and < 100)--each with their respective modified data--and then delete the original row from which they were copied. I know almost nothing about writing macros, but I can guess that it might be easier if the source row were unchanged during the iterations.

--

ALSO: I need this to work for rows with multiple % splits (e.g. Row 27: Column X (10%), Column Y (10%) … Column AG (10%) … [etc.]); I need to insert enough rows to eliminate all % splits (resulting in columns X through AG only containing “0%” or “100%” values). The macro must be able to detect the number of % splits and the % in each column in order to determine the number of rows to insert, and to calculate the value to be placed in the amount column of each new row.

I don’t particular care if this requires multiple iterations, though it would be nice if it could be done in one step. It would also be great if this could be applied to an entire spreadsheet without much manual involvement.

I got my question answered through another forum. Just in case someone else has a similar problem and wants to see the solution, here's the code I finally ended up using:

--------

Sub x()

Dim rPct As Range

Dim rAmt As Range

Dim iRow As Long

Dim iCol As Long

Dim nCol As LongSet rAmt = ActiveSheet.Range("X2:X456", ActiveSheet.Cells(Rows.Count, "AG").End(xlUp))

Set rPct = Intersect(rAmt.EntireRow, Columns("X:AG"))

Set rAmt = Intersect(rPct.EntireRow, Columns("AH"))

nCol = rPct.Columns.CountFor iRow = rPct.Rows.Count To 1 Step -1

Select Case Round(WorksheetFunction.Sum(rPct.Rows(iRow)), 0)

Case 0#Case 1#

With rPct.Rows(iRow).EntireRow

.Copy

.Offset(1).Resize(nCol).Insert

rPct.Rows(iRow).Offset(1).Resize(nCol).Value2 = 0#

End WithFor iCol = nCol To 1 Step -1

If rPct(iRow, iCol).Value2 = 0# Then

rPct.Rows(iRow).Offset(iCol).EntireRow.Delete

Else

rPct(iRow, iCol).Offset(iCol).Value2 = 1#

rAmt(iRow).Offset(iCol).Value = rPct(iRow, iCol).Value2 * rAmt(iRow).Value2

End If

Next iColrPct.Rows(iRow).EntireRow.Delete

Case Else

If Round(WorksheetFunction.Sum(rPct.Rows(iRow)), 0) <> 1# Then

With rPct.Rows(iRow)

.Interior.Color = vbRed

.Select

End With

MsgBox "Total <> 100%"

Exit Sub

End If

End Select

Next iRow

End Sub

--------(In the line "Set rAmt = ActiveSheet.Range("X2:X456", [...])", the 456 is based on the number of rows in the spreadsheet.)

If you have a similar situation, beware that it might take a long time for the macro to run through the entire spreadsheet (especially if you have a few dozen columns of information). I copied the relevant rows into a new spreadsheet, ran the macro on them, and then pasted the new rows back into the spreadsheet over the old rows. Worked like a charm, and was much faster than doing it manually!

Ask Your Question

Weekly Poll

How long do you think until flying cars or taxis are common?

Discuss in The Lounge

Poll History