Check totals in range
 

What I am trying to do is very dfficult to explan so apologies if I
ramble a bit trying to give clarity. The ranges in question will take
the format as below

NJ/44724/64506 3.37 SB 3.00
NJ/44724/64506 3.37 TGRS 0.37
NJ/44765/65200 16.24 UCL 8.00
NJ/44765/65200 16.24 SB 8.00
NJ/44765/65200 16.24 WBS 0.24
NJ/44880/64631 6.57 SAAP-A 4.00
NJ/44880/64631 6.57 TGRS 2.57
NJ/44957/65040 6.64 TGRS 6.64
NJ/44982/64520 3.04 TGRS 3.00
NJ/44982/64520 3.04 RGR 0.04
NJ/45223/64964 3.47 SB 3.47
NJ/45224/65138 7.96 SB 7.00
NJ/45224/65138 7.96 AGRI 0.50
NJ/45224/65138 7.96 RGR 0.46
NJ/45345/64767 4.61 PGRS 4.61
NJ/45427/64929 8.95 SB 8.00
NJ/45427/64929 8.95 RGR 0.55
NJ/45427/64929 8.95 AGRI 0.40
NJ/40494/40551 3.28 TGRS 3.28

Column A is a list of field locations, some of which you will see are
duplicated and column B is the total area of these fields , again
duplicated.
The columns to the right of these break down these total areas into
component parts eg the field with an area of 16.24 is broken down into 3
areas, 8.00 and 0.24 in Column E and 8.00 in Column G. These last three
figures are entered by the user. What is important is to check that
these 3 entries add up to the total field area of 16.24. The entries
will always be in column E and /or column G. What I want to do is after
all the entries are made is to run a procedure which will run down the
range and check that the entries for each field match the total area,
then insert a conditional formting to highlight the offending field in
colour. The randomness of the duplicates is throwing me where there are
sometimes one field total, sometimes 2, 3 etc depending on the breakdown
of the total area. I hope this is understandable and I would value any
guidance.

Kind Regards,
Graham
Turriff
Scotland

Check totals in range
 

On Mar 21, 8:06*pm, Graham wrote:
What I am trying to do is very dfficult to explan so apologies if I
ramble a bit trying to give clarity. The ranges in question will take
the format as below

NJ/44724/64506 *3.37 * * * * * *SB * * *3.00 * * * * * *
NJ/44724/64506 *3.37 * * * * * *TGRS * *0.37 * * * * * *
NJ/44765/65200 *16.24 * * * * * * * * * * * * * UCL * * 8.00
NJ/44765/65200 *16.24 * * * * * SB * * *8.00 * * * * * *
NJ/44765/65200 *16.24 * * * * * WBS * * 0.24 * * * * * *
NJ/44880/64631 *6.57 * * * * * *SAAP-A *4.00 * * * * * *
NJ/44880/64631 *6.57 * * * * * * * * * * * * * *TGRS * *2.57
NJ/44957/65040 *6.64 * * * * * *TGRS * *6.64 * * * * * *
NJ/44982/64520 *3.04 * * * * * *TGRS * *3.00 * * * * * *
NJ/44982/64520 *3.04 * * * * * *RGR * * 0.04 * * * * * *
NJ/45223/64964 *3.47 * * * * * * * * * * * * * *SB * * *3.47
NJ/45224/65138 *7.96 * * * * * *SB * * *7.00 * * * * * *
NJ/45224/65138 *7.96 * * * * * *AGRI * *0.50 * * * * * *
NJ/45224/65138 *7.96 * * * * * *RGR * * 0.46 * * * * * *
NJ/45345/64767 *4.61 * * * * * *PGRS * *4.61 * * * * * *
NJ/45427/64929 *8.95 * * * * * *SB * * *8.00 * * * * * *
NJ/45427/64929 *8.95 * * * * * * * * * * * * * *RGR * * 0.55
NJ/45427/64929 *8.95 * * * * * *AGRI * *0.40 * * * * * *
NJ/40494/40551 *3.28 * * * * * *TGRS * *3.28 * * * * * *

Column A is a list of field locations, some of which you will see are
duplicated and column B is the total area of these fields , again
duplicated.
The columns to the right of these break down these total areas into
component parts eg the field with an area of 16.24 is broken down into 3
areas, 8.00 and 0.24 in Column E and 8.00 in Column G. These last three
figures are entered by the user. What is important is to check that
these 3 entries add up to the total field area *of 16.24. The entries
will always be in column E and /or *column G. What I want to do is after
all the entries are made is to run a procedure which will run down the
range and check that the entries for each field match the total area,
then insert a conditional formting to highlight the offending field in
colour. The randomness of the duplicates is throwing me where there are
sometimes one field total, sometimes 2, 3 etc depending on the breakdown
of the total area. I hope this is understandable and I would value any
guidance.

Kind Regards,
Graham
Turriff
Scotland



Phillip London UK
This works for me

'Assumptions
'Data you show starts at A1
'The codes in column A have no empty rows between them
'There is no data after column G


Sub ShowIncorrectTotals()
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(1)
Rng.Interior.ColorIndex = xlNone
NextRow = 1

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, 4).Value + cl.Offset(0, 6).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, 4).Value + cl.Offset(0, 6).Value
TotB = TotB + cl.Offset(1, 4).Value + cl.Offset(1,
6).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, 4).Value + cl.Offset(0, 6).Value
TotB = TotB + cl.Offset(1, 4).Value + cl.Offset(1,
6).Value
TotB = TotB + cl.Offset(2, 4).Value + cl.Offset(2,
6).Value
If Round(TotA, 2) < Round(TotB, 2) Then
Rng.Rows(cl.Row & ":" & cl.Row +
2).Interior.ColorIndex = 6
End If
End Select
End If
Next


End Sub

Check totals in range
 

Phillip wrote:
On Mar 21, 8:06 pm, Graham wrote:
What I am trying to do is very dfficult to explan so apologies if I
ramble a bit trying to give clarity. The ranges in question will take
the format as below

NJ/44724/64506 3.37 SB 3.00
NJ/44724/64506 3.37 TGRS 0.37
NJ/44765/65200 16.24 UCL 8.00
NJ/44765/65200 16.24 SB 8.00
NJ/44765/65200 16.24 WBS 0.24
NJ/44880/64631 6.57 SAAP-A 4.00
NJ/44880/64631 6.57 TGRS 2.57
NJ/44957/65040 6.64 TGRS 6.64
NJ/44982/64520 3.04 TGRS 3.00
NJ/44982/64520 3.04 RGR 0.04
NJ/45223/64964 3.47 SB 3.47
NJ/45224/65138 7.96 SB 7.00
NJ/45224/65138 7.96 AGRI 0.50
NJ/45224/65138 7.96 RGR 0.46
NJ/45345/64767 4.61 PGRS 4.61
NJ/45427/64929 8.95 SB 8.00
NJ/45427/64929 8.95 RGR 0.55
NJ/45427/64929 8.95 AGRI 0.40
NJ/40494/40551 3.28 TGRS 3.28

Column A is a list of field locations, some of which you will see are
duplicated and column B is the total area of these fields , again
duplicated.
The columns to the right of these break down these total areas into
component parts eg the field with an area of 16.24 is broken down into 3
areas, 8.00 and 0.24 in Column E and 8.00 in Column G. These last three
figures are entered by the user. What is important is to check that
these 3 entries add up to the total field area of 16.24. The entries
will always be in column E and /or column G. What I want to do is after
all the entries are made is to run a procedure which will run down the
range and check that the entries for each field match the total area,
then insert a conditional formting to highlight the offending field in
colour. The randomness of the duplicates is throwing me where there are
sometimes one field total, sometimes 2, 3 etc depending on the breakdown
of the total area. I hope this is understandable and I would value any
guidance.

Kind Regards,
Graham
Turriff
Scotland



Phillip London UK
This works for me

'Assumptions
'Data you show starts at A1
'The codes in column A have no empty rows between them
'There is no data after column G


Sub ShowIncorrectTotals()
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(1)
Rng.Interior.ColorIndex = xlNone
NextRow = 1

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, 4).Value + cl.Offset(0, 6).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, 4).Value + cl.Offset(0, 6).Value
TotB = TotB + cl.Offset(1, 4).Value + cl.Offset(1,
6).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, 4).Value + cl.Offset(0, 6).Value
TotB = TotB + cl.Offset(1, 4).Value + cl.Offset(1,
6).Value
TotB = TotB + cl.Offset(2, 4).Value + cl.Offset(2,
6).Value
If Round(TotA, 2) < Round(TotB, 2) Then
Rng.Rows(cl.Row & ":" & cl.Row +
2).Interior.ColorIndex = 6
End If
End Select
End If
Next


End Sub




Sorry for delay in reply Phillip. Iam both amazed that you managed to
untangle my explanation of what I was after and staggered by the
effectiveness of the procedure in achieving just what I want. I am very
grateful to you for all your help. Many thakks.

Graham