Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Sum in blank Row
You should really stick with the original thread rather than start new ones
for the same basic question. Here is the solution I posted back in the original thread; the code below is meant to replace the subroutine I gave you earlier... it will insert the double blank rows and then put the appropriate SUM formulas in Columns D thru H (I used formulas so you could manually edit your data in case you find an error). Here is what I posted earlier... Does this subroutine do what you want? Sub InsertTwoRows() Dim X As Long Dim Z As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow To 1 Step -1 If X = LastRow Or (Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value) Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "C").Value = "Totals: " .Cells(X + 1, "C").HorizontalAlignment = xlRight End If Next LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For X = 1 To LastRow If .Cells(X, "C").Value = "Totals: " Then For Z = 4 To 8 Cells(X, Z).Formula = "=SUM(" & Chr$(Z + 64) & _ Cells(X, "C").End(xlUp).Row & ":" & _ Chr$(Z + 64) & (X - 1) & ")" Next End If Next End With End Sub Rick "Rayashe" wrote in message ... Following on to this (I probably should have added it in on the first query): In the one blank row that has now been created after each client, I need to put a total in columns D, E, F, G & H. Again due to the differences in number of months per client it is not a case of just simply copying the formula. "Rick Rothstein (MVP - VB)" wrote: A subroutine like this should work (just change the worksheet reference from Sheet1 to your actual worksheet name)... Sub InsertTwoRows() Dim X As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow - 1 To 1 Step -1 If Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown End If Next End With End Sub Rick "Rayashe" wrote in message ... I have all my clients sorted in a sheet with column A containing month 1, 2, 3, 4, up to 12 - then column B has the client code, column C client Surname and Name. I need to insert 2 rows after each client and need a code to be able to do this as there are over 500 clients. I have filtered to show unique on column B, and to do a simple keystroke is DOWN, DOWN, DOWN, INSERT ROW, INSERT ROW. The problem is that some clients started and ended at various times during the year, so not all have the same number of entries. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Sum in blank Row
I'll say it again Rick - YOU'RE A GENIUS!!!!
Thank you - it does exactly what I required "Rick Rothstein (MVP - VB)" wrote: You should really stick with the original thread rather than start new ones for the same basic question. Here is the solution I posted back in the original thread; the code below is meant to replace the subroutine I gave you earlier... it will insert the double blank rows and then put the appropriate SUM formulas in Columns D thru H (I used formulas so you could manually edit your data in case you find an error). Here is what I posted earlier... Does this subroutine do what you want? Sub InsertTwoRows() Dim X As Long Dim Z As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow To 1 Step -1 If X = LastRow Or (Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value) Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "C").Value = "Totals: " .Cells(X + 1, "C").HorizontalAlignment = xlRight End If Next LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For X = 1 To LastRow If .Cells(X, "C").Value = "Totals: " Then For Z = 4 To 8 Cells(X, Z).Formula = "=SUM(" & Chr$(Z + 64) & _ Cells(X, "C").End(xlUp).Row & ":" & _ Chr$(Z + 64) & (X - 1) & ")" Next End If Next End With End Sub Rick "Rayashe" wrote in message ... Following on to this (I probably should have added it in on the first query): In the one blank row that has now been created after each client, I need to put a total in columns D, E, F, G & H. Again due to the differences in number of months per client it is not a case of just simply copying the formula. "Rick Rothstein (MVP - VB)" wrote: A subroutine like this should work (just change the worksheet reference from Sheet1 to your actual worksheet name)... Sub InsertTwoRows() Dim X As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow - 1 To 1 Step -1 If Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown End If Next End With End Sub Rick "Rayashe" wrote in message ... I have all my clients sorted in a sheet with column A containing month 1, 2, 3, 4, up to 12 - then column B has the client code, column C client Surname and Name. I need to insert 2 rows after each client and need a code to be able to do this as there are over 500 clients. I have filtered to show unique on column B, and to do a simple keystroke is DOWN, DOWN, DOWN, INSERT ROW, INSERT ROW. The problem is that some clients started and ended at various times during the year, so not all have the same number of entries. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Sum in blank Row
I'll say it again Rick - YOU'RE A GENIUS!!!!
Then I'm afraid your standards for determining such a status are set way too low.<g Thank you - it does exactly what I required Great! I'm glad my code has worked out for you. Rick "Rick Rothstein (MVP - VB)" wrote: You should really stick with the original thread rather than start new ones for the same basic question. Here is the solution I posted back in the original thread; the code below is meant to replace the subroutine I gave you earlier... it will insert the double blank rows and then put the appropriate SUM formulas in Columns D thru H (I used formulas so you could manually edit your data in case you find an error). Here is what I posted earlier... Does this subroutine do what you want? Sub InsertTwoRows() Dim X As Long Dim Z As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow To 1 Step -1 If X = LastRow Or (Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value) Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "C").Value = "Totals: " .Cells(X + 1, "C").HorizontalAlignment = xlRight End If Next LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For X = 1 To LastRow If .Cells(X, "C").Value = "Totals: " Then For Z = 4 To 8 Cells(X, Z).Formula = "=SUM(" & Chr$(Z + 64) & _ Cells(X, "C").End(xlUp).Row & ":" & _ Chr$(Z + 64) & (X - 1) & ")" Next End If Next End With End Sub Rick "Rayashe" wrote in message ... Following on to this (I probably should have added it in on the first query): In the one blank row that has now been created after each client, I need to put a total in columns D, E, F, G & H. Again due to the differences in number of months per client it is not a case of just simply copying the formula. "Rick Rothstein (MVP - VB)" wrote: A subroutine like this should work (just change the worksheet reference from Sheet1 to your actual worksheet name)... Sub InsertTwoRows() Dim X As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow - 1 To 1 Step -1 If Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown End If Next End With End Sub Rick "Rayashe" wrote in message ... I have all my clients sorted in a sheet with column A containing month 1, 2, 3, 4, up to 12 - then column B has the client code, column C client Surname and Name. I need to insert 2 rows after each client and need a code to be able to do this as there are over 500 clients. I have filtered to show unique on column B, and to do a simple keystroke is DOWN, DOWN, DOWN, INSERT ROW, INSERT ROW. The problem is that some clients started and ended at various times during the year, so not all have the same number of entries. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Sum in blank Row
No genius here, but happy to share this with you:
Sub subtotaltest() 'place a subtotal in column(V) wherever column(U) has a blank cell Dim lRow As Long Dim cell As Range Dim RowCount As Long Application.Calculation = xlCalculationManual Application.ScreenUpdating = False lRow = Range("A65536").End(xlUp).Row + 1 RowCount = 0 For Each cell In Range("A2:A" & lRow) If IsEmpty(cell) Then cell.Offset(0, 1).FormulaR1C1 = "=SUM(R[" & -RowCount & "]C[-1]:R[-1]C[-1])" RowCount = 0 Else RowCount = RowCount + 1 End If Next cell Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Regards, Ryan--- -- RyGuy "Rick Rothstein (MVP - VB)" wrote: I'll say it again Rick - YOU'RE A GENIUS!!!! Then I'm afraid your standards for determining such a status are set way too low.<g Thank you - it does exactly what I required Great! I'm glad my code has worked out for you. Rick "Rick Rothstein (MVP - VB)" wrote: You should really stick with the original thread rather than start new ones for the same basic question. Here is the solution I posted back in the original thread; the code below is meant to replace the subroutine I gave you earlier... it will insert the double blank rows and then put the appropriate SUM formulas in Columns D thru H (I used formulas so you could manually edit your data in case you find an error). Here is what I posted earlier... Does this subroutine do what you want? Sub InsertTwoRows() Dim X As Long Dim Z As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow To 1 Step -1 If X = LastRow Or (Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value) Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "C").Value = "Totals: " .Cells(X + 1, "C").HorizontalAlignment = xlRight End If Next LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For X = 1 To LastRow If .Cells(X, "C").Value = "Totals: " Then For Z = 4 To 8 Cells(X, Z).Formula = "=SUM(" & Chr$(Z + 64) & _ Cells(X, "C").End(xlUp).Row & ":" & _ Chr$(Z + 64) & (X - 1) & ")" Next End If Next End With End Sub Rick "Rayashe" wrote in message ... Following on to this (I probably should have added it in on the first query): In the one blank row that has now been created after each client, I need to put a total in columns D, E, F, G & H. Again due to the differences in number of months per client it is not a case of just simply copying the formula. "Rick Rothstein (MVP - VB)" wrote: A subroutine like this should work (just change the worksheet reference from Sheet1 to your actual worksheet name)... Sub InsertTwoRows() Dim X As Long Dim LastRow As Long With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For X = LastRow - 1 To 1 Step -1 If Len(.Cells(X, "B").Value) 0 And _ Len(.Cells(X + 1, "B").Value) 0 And _ .Cells(X, "B").Value < .Cells(X + 1, "B").Value Then .Cells(X + 1, "B").EntireRow.Insert xlShiftDown .Cells(X + 1, "B").EntireRow.Insert xlShiftDown End If Next End With End Sub Rick "Rayashe" wrote in message ... I have all my clients sorted in a sheet with column A containing month 1, 2, 3, 4, up to 12 - then column B has the client code, column C client Surname and Name. I need to insert 2 rows after each client and need a code to be able to do this as there are over 500 clients. I have filtered to show unique on column B, and to do a simple keystroke is DOWN, DOWN, DOWN, INSERT ROW, INSERT ROW. The problem is that some clients started and ended at various times during the year, so not all have the same number of entries. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How can I insert a true blank inst. of a non-blank zero string | Excel Worksheet Functions | |||
Start Cell B1 then find first blank cell, insert subtotal, next non blank, then next blank, sutotal cells in between......... | Excel Programming | |||
Macro to insert copy and insert formulas only to next blank row | Excel Programming | |||
Macro code to test for blank row and insert blank row if false | Excel Programming | |||
Insert A blank Row | Excel Programming |