| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Missing blanks
I modified a procedure which Phillip was kind enough to send me a short
time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Hi Graham
Try this Set RngA = Range("H13", Range("H65536").End(xlUp)) Regards, Per On 24 Mar., 13:31, Graham wrote: I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, * *I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() * * *Dim Rng As Range * * *Dim rngA As Range * * *Dim TotA As Double * * *Dim TotB As Double * * *Dim cl As Range * * *Dim NextRow As Integer * * *Dim ValueTomatch As String * * *Set Rng = ActiveSheet.UsedRange * * * Set rngA = Rng.Columns(8) * * *Rng.Interior.ColorIndex = xlNone * * *NextRow = 1 On Error Resume Next * * *For Each cl In rngA.Cells * * If NextRow = cl.Row Then * * ValueTomatch = cl.Text * *TotA = cl.Offset(0, 1).Value * *Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) * *Case 1 * *NextRow = cl.Row + 1 * TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value * If Round(TotA, 2) < Round(TotB, 2) Then * Rng.Rows(cl.Row).Interior.ColorIndex = 6 * End If * Case 2 * NextRow = cl.Row + 2 * TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value * TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value * If Round(TotA, 2) < Round(TotB, 2) Then * Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 * End If * Case 3 * NextRow = cl.Row + 3 * TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value * TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value * TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value * If Round(TotA, 2) < Round(TotB, 2) Then * Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 * End If * Case 4 * NextRow = cl.Row + 4 * TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value * TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value * TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value * TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value * If Round(TotA, 2) < Round(TotB, 2) Then * Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 * End If * Case 5 * NextRow = cl.Row + 5 * TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value * TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value * TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value * TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value * TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 * End If * End Select * End If * Next End Sub |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Just taking a quick look at your code...
Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Hi Per,
Had tried that one, didn't like it either. The rng, ie Activesheet.UsedRange will always include A1 so I am stuck with atarting at row 1. Thanks for feedback though. Graham Per Jessen wrote: Hi Graham Try this Set RngA = Range("H13", Range("H65536").End(xlUp)) Regards, Per On 24 Mar., 13:31, Graham wrote: I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Hi Mark,
Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Graham,
Maybe a redraw of this macro would be in order. Would you mind me taking a look at the workbook? If not, can you provide some instructions on what you need it to do. Mark ( email - wmivey6311 AT hotmail DOT com) "Graham" wrote in message ... Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
I think Mark and Per were on the right track. If both of these changes are
made it should start on row 13. See modified portion of code below. Also, I could not see any reason to reference the UsedRange throughout the procedure, but my old eyes are not what they used to be. I could be missing something without actually running the code. Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod Set Rng = ActiveSheet.UsedRange Set rngA = Range("H13" & LstRow) '<<<<<mod Rng.Interior.ColorIndex = xlNone NextRow = 13 '<<<<<mod "Graham" wrote: Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Sorry I am still being a pain, but it will run but not identify the
problem rows. I reference my original post which gave a bit more detail, 21st March, 20:06, "Check Totals in range". Note that this shows what I am now referring to as column 8 in the first column and does not show the blanks above it or the fact that the used range still starts at A1. The used range still comes into it as per the formating of the offending rows Rng.Rows(cl.Row).Interior.ColorIndex = 6 Thanks for your continued help. Graham JLGWhiz wrote: I think Mark and Per were on the right track. If both of these changes are made it should start on row 13. See modified portion of code below. Also, I could not see any reason to reference the UsedRange throughout the procedure, but my old eyes are not what they used to be. I could be missing something without actually running the code. Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod Set Rng = ActiveSheet.UsedRange Set rngA = Range("H13" & LstRow) '<<<<<mod Rng.Interior.ColorIndex = xlNone NextRow = 13 '<<<<<mod "Graham" wrote: Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Graham,
I can roughly see your problem, but like I said you should consider a totally new macro. Would you mind sending me a copy of the workbook so I can give it a go... It appears like you do want the first 12 rows evaluated, but possibly for some different criteria??? Mark (wmivey6311 AT hotmail DOT com) "Graham" wrote in message ... Sorry I am still being a pain, but it will run but not identify the problem rows. I reference my original post which gave a bit more detail, 21st March, 20:06, "Check Totals in range". Note that this shows what I am now referring to as column 8 in the first column and does not show the blanks above it or the fact that the used range still starts at A1. The used range still comes into it as per the formating of the offending rows Rng.Rows(cl.Row).Interior.ColorIndex = 6 Thanks for your continued help. Graham JLGWhiz wrote: I think Mark and Per were on the right track. If both of these changes are made it should start on row 13. See modified portion of code below. Also, I could not see any reason to reference the UsedRange throughout the procedure, but my old eyes are not what they used to be. I could be missing something without actually running the code. Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod Set Rng = ActiveSheet.UsedRange Set rngA = Range("H13" & LstRow) '<<<<<mod Rng.Interior.ColorIndex = xlNone NextRow = 13 '<<<<<mod "Graham" wrote: Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Mark,
After going trough the replies I made some of the modifications then in the Case procedures I changed the Rng.Rows(Cl.Row) to Rng.Rows(Cl.Row-12) and modified the others porportionately. The detail is shown below. This seems to have done the trick and I have tried it in a range of situations. I appreciate your offer of trying a re write but I think this is asking too much and I am already very grateful for all the input which seems to have resolved the problem. If it all falls apart again I may take you up on the offer:) Kind Regards, Graham Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = Range("A13:t400") '<<<<modified Set rngA = Range("h13:h400") '<<<<modified ' Set Rng = ActiveSheet.UsedRange 'Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 13 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12).Interior.ColorIndex = 6 '<<<<modified End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & (cl.Row - 11)).Interior.ColorIndex = 6 '<<<<modified End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & cl.Row - 10).Interior.ColorIndex = 6 '<<<<modified End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & cl.Row - 9).Interior.ColorIndex = 6 '<<<<modified End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & cl.Row - 8).Interior.ColorIndex = 6 '<<<<modified End If End Select End If Next End Sub Mark Ivey wrote: Graham, I can roughly see your problem, but like I said you should consider a totally new macro. Would you mind sending me a copy of the workbook so I can give it a go... It appears like you do want the first 12 rows evaluated, but possibly for some different criteria??? Mark (wmivey6311 AT hotmail DOT com) "Graham" wrote in message ... Sorry I am still being a pain, but it will run but not identify the problem rows. I reference my original post which gave a bit more detail, 21st March, 20:06, "Check Totals in range". Note that this shows what I am now referring to as column 8 in the first column and does not show the blanks above it or the fact that the used range still starts at A1. The used range still comes into it as per the formating of the offending rows Rng.Rows(cl.Row).Interior.ColorIndex = 6 Thanks for your continued help. Graham JLGWhiz wrote: I think Mark and Per were on the right track. If both of these changes are made it should start on row 13. See modified portion of code below. Also, I could not see any reason to reference the UsedRange throughout the procedure, but my old eyes are not what they used to be. I could be missing something without actually running the code. Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod Set Rng = ActiveSheet.UsedRange Set rngA = Range("H13" & LstRow) '<<<<<mod Rng.Interior.ColorIndex = xlNone NextRow = 13 '<<<<<mod "Graham" wrote: Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
Glad it all worked out...
Let me know if I can help out any further... Mark "Graham" wrote in message ... Mark, After going trough the replies I made some of the modifications then in the Case procedures I changed the Rng.Rows(Cl.Row) to Rng.Rows(Cl.Row-12) and modified the others porportionately. The detail is shown below. This seems to have done the trick and I have tried it in a range of situations. I appreciate your offer of trying a re write but I think this is asking too much and I am already very grateful for all the input which seems to have resolved the problem. If it all falls apart again I may take you up on the offer:) Kind Regards, Graham Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = Range("A13:t400") '<<<<modified Set rngA = Range("h13:h400") '<<<<modified ' Set Rng = ActiveSheet.UsedRange 'Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 13 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12).Interior.ColorIndex = 6 '<<<<modified End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & (cl.Row - 11)).Interior.ColorIndex = 6 '<<<<modified End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & cl.Row - 10).Interior.ColorIndex = 6 '<<<<modified End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & cl.Row - 9).Interior.ColorIndex = 6 '<<<<modified End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row - 12 & ":" & cl.Row - 8).Interior.ColorIndex = 6 '<<<<modified End If End Select End If Next End Sub Mark Ivey wrote: Graham, I can roughly see your problem, but like I said you should consider a totally new macro. Would you mind sending me a copy of the workbook so I can give it a go... It appears like you do want the first 12 rows evaluated, but possibly for some different criteria??? Mark (wmivey6311 AT hotmail DOT com) "Graham" wrote in message ... Sorry I am still being a pain, but it will run but not identify the problem rows. I reference my original post which gave a bit more detail, 21st March, 20:06, "Check Totals in range". Note that this shows what I am now referring to as column 8 in the first column and does not show the blanks above it or the fact that the used range still starts at A1. The used range still comes into it as per the formating of the offending rows Rng.Rows(cl.Row).Interior.ColorIndex = 6 Thanks for your continued help. Graham JLGWhiz wrote: I think Mark and Per were on the right track. If both of these changes are made it should start on row 13. See modified portion of code below. Also, I could not see any reason to reference the UsedRange throughout the procedure, but my old eyes are not what they used to be. I could be missing something without actually running the code. Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod Set Rng = ActiveSheet.UsedRange Set rngA = Range("H13" & LstRow) '<<<<<mod Rng.Interior.ColorIndex = xlNone NextRow = 13 '<<<<<mod "Graham" wrote: Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Missing blanks
I was going to suggest that you use either the locals window to see what your
variables equate to as they are initialized or use the mouse over feature and step through your code to see if the values are what you expect as each line of code is initialized. This, for me, is the easiest way to determine which part of my code needs to be fixed when I am getting undesired results. I know it can be frustrating and more than that, when the solution is found, it is always the most simple thing. "Graham" wrote: Sorry I am still being a pain, but it will run but not identify the problem rows. I reference my original post which gave a bit more detail, 21st March, 20:06, "Check Totals in range". Note that this shows what I am now referring to as column 8 in the first column and does not show the blanks above it or the fact that the used range still starts at A1. The used range still comes into it as per the formating of the offending rows Rng.Rows(cl.Row).Interior.ColorIndex = 6 Thanks for your continued help. Graham JLGWhiz wrote: I think Mark and Per were on the right track. If both of these changes are made it should start on row 13. See modified portion of code below. Also, I could not see any reason to reference the UsedRange throughout the procedure, but my old eyes are not what they used to be. I could be missing something without actually running the code. Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod Set Rng = ActiveSheet.UsedRange Set rngA = Range("H13" & LstRow) '<<<<<mod Rng.Interior.ColorIndex = xlNone NextRow = 13 '<<<<<mod "Graham" wrote: Hi Mark, Reply as to Per. Tried that as well but problem is with being stuck with the used range including row 1. Thanks for input. Graham Mark Ivey wrote: Just taking a quick look at your code... Try changing the following line of your code: NextRow = 1 TO THIS... NextRow = 13 This should start you at row 13. Mark "Graham" wrote in message ... I modified a procedure which Phillip was kind enough to send me a short time ago. It does what it should but I have one problem which I cannot seem to get round. In column 8 the first 12 cells will always be blank, I cannot put anything in them in this situation so need to work round it. Basically it means the procedure doesn't need to start until it reaches row 13. I have tried putting in If statements like "if not isempty" to jump the procedure forward but cannot get it to work. If I put values in the cells, as long as there are not more than 6 of the same it works but I don't have the luxury of being able to put values in these in this circumstance. I would be grateful for any guidance. Kind Regards Graham Turriff Scotland Sub gmhtrial() Dim Rng As Range Dim rngA As Range Dim TotA As Double Dim TotB As Double Dim cl As Range Dim NextRow As Integer Dim ValueTomatch As String Set Rng = ActiveSheet.UsedRange Set rngA = Rng.Columns(8) Rng.Interior.ColorIndex = xlNone NextRow = 1 On Error Resume Next For Each cl In rngA.Cells If NextRow = cl.Row Then ValueTomatch = cl.Text TotA = cl.Offset(0, 1).Value Select Case WorksheetFunction.CountIf(rngA, ValueTomatch) Case 1 NextRow = cl.Row + 1 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row).Interior.ColorIndex = 6 End If Case 2 NextRow = cl.Row + 2 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6 End If Case 3 NextRow = cl.Row + 3 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6 End If Case 4 NextRow = cl.Row + 4 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6 End If Case 5 NextRow = cl.Row + 5 TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value If Round(TotA, 2) < Round(TotB, 2) Then Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6 End If End Select End If Next End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Lookup missing number(s) in column w/blanks & duplicates | Excel Worksheet Functions | |||
| Sumproduct copying blanks or how to insert zero into blanks | Excel Worksheet Functions | |||
| copy range of cells with blanks then paste without blanks | Excel Programming | |||
| copy range of cells with blanks then paste without blanks | Excel Worksheet Functions | |||
| Paste Special Skip Blanks not skipping blanks, but overwriting... | Excel Discussion (Misc queries) | |||
![Graham[_2_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
