On Mar 21, 8:06*pm, Graham <gra...@haughs.orangehome.co.uk> 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
|
Similar Threads
