need a code.....

[foxbat]

Hi


I’ve just started to use vba and think it will be able to help me. I’ve just been sent somewhere new (and of course didn’t bring my vba book with me) with my job for a few months. Since being here I think a small code may make my job so much easier as i’m doing it all by hand and checking at the minute.
I’m using excel 2003. I think I need 4 fields e.g


field1 field2 field3 field4


sw ci 14 18
sl ck 19 21


I need to know if should I allocate a job to new employee the same location – field 2 – and a confliction happens on the job no range – fields 2 & 3- inclusive then the confliction to highlight maybe by changing colour.
For example if I now allocated ‘cw’ location ci and job no’s 15 and 16 then there is a confliction with sw as he has been allocated 14 to 18. I appreciate it looks easy with just the 2 on the list but I can have up to fifty or more and the tasking needs to be dynamic.
Any help would be greatly appreciated.
Thanks very much for your time.

[GTO]

I need to know if should I allocate a job to new employee the same location – field 2 – and a confliction happens on the job no range – fields 2 & 3- inclusive then the confliction to highlight maybe by changing colour.

Greetings foxbat,

Eh?

Maybe just me, but I am not getting what you are trying to do. Could you attach an example workbook? No company/private info, but enough that we could see expected data and what (maybe a description) is supposed (desired) to happen should a "conflict" occur.

Hope to help,

Mark

[mdmackillop]

Could you use conditional formatting?
=COUNTIF(A:A,A1)>1
Will highlight duplicate entries in that column.

[foxbat]

Hi Mark

Thanks for the reply, no its me i re-read what i'd posted and it doesn't make a lot of sense though it did at 5 in the morning when i typed it before work!
Hopefully the spreadsheet will bring more clarity. I appreciate its an openoffice doc but i'm running linux on my laptop that i've brought with me it should open ok in excel. Its windows and excel 2003 at work.
Thanks for your time and hopefully you can help as i work in an ops centre, the work can come flying in and i've got a laminated sheet in front of me with a water soluble pen to keep track.
Again any help is greatly appreciated,
Steve

[foxbat]

Thanks mdmack,

Its about 40 to 50 rows. I'm just trying to attach a spraedsheet but failed in my previous post, i'm trying again now.
As i said i'm an absolute newb who only started about a month ago, my some total of programming so far is a simple 'if' one that counted and added lots of rows if certain parameters were true. I just got sent on this job and saw what the guys were using and thought there must be a more efficient way of working
I'll try this attachment again.
Thanks

[foxbat]

I can't upload an ods file and i haven't made enough posts to create a link so i will try and post one from a work computer tomorrow.
Thanks guys.

[mdmackillop]

Try zipping it first.

[foxbat]

[IMG]file:///tmp/moz-screenshot.jpg[/IMG]

i've tried to attach a screenshot, I'll see if this works.

[mdmackillop]

Use Manage Attachments to show a jpg

[foxbat]

I think i've managed to attach an xls file! Sorry for being a biff guys, thanks for your patience.
Hopefully this clears it up. I was thinking of trying to do something like an IF function with =>. But seeing your COUNT it just drove home how sparse my knowledge is. Hopefully I won't be as bad at learning vba as I am at posting in forums!
Thanks

Steve

[mdmackillop]

[VBA]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Locat As Range, aFr As Range, aTo As Range, c As Range
Dim FirstAddress As String
Dim Low As Long, High As Long

If Target.Column <= 4 Then
Set Locat = Cells(Target.Row, 2)
Set aFr = Cells(Target.Row, 3)
Set aTo = Cells(Target.Row, 4)
Locat.Resize(, 3).Interior.ColorIndex = xlNone
With Columns(2)
Set c = .Find(Locat, LookIn:=xlValues, After:=Locat)
If Not c Is Nothing Then
FirstAddress = Locat.Address
Do
Low = c.Offset(, 1)
High = c.Offset(, 2)
If aFr >= Low And aFr <= High Then
aFr.Interior.ColorIndex = 6
End If
If aTo >= Low And aTo <= High Then
aTo.Interior.ColorIndex = 6
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
End If
End Sub
[/VBA]

[foxbat]

Thanks very much MdMack

Going to input this now, i'll let you know how it goes.

Cheers

Steve

[Aussiebear]

Hmmm.... Sorry Steve but I can't follow the logic here. You are saying that if you enter fb (new person) at ci a similar location to sw & cw, that sw & cw's allocations overlap, yet when they ci & cw are at the same location, but fb doesn't get allocated, this is fine???

[foxbat]

Aussie

No I was saying that the locations can be the same as long as the allocations don't conflict, i need to know if i enter a new employee and give an allocation that i have already given out. In the remarks I made please read '....column changing colour or a...'. Hope this clears it up a little for you. I appreciate it looks simple with 4 entries and it is but whan I have 30 or 40 on my board sometimes its easy to makea mistake and my boss is breathing down my neck to give hime the allocation asap.

[Aussiebear]

Sorry but that is not what is in your workbook

[mdmackillop]

Why not check availability first? (Assuming I understand what is meant to be happening!)
BTW The info is confusing and data too limited. It is worth making up a realistic example to get things right first time.

[foxbat]

Hi guys

Sorry Due to download restrictions on my works computers I can't look at the worksheet you've uploaded. Mdmack the code you've already given is almost bang on. The only thing is that the original inputs are turning yellow. Is there any chance that the text could remain black and white until there is a confliction and that box change colour where the confliction occurs just to highlight that i've made a duplication in job allocation.
I'll upload a exact sample of ten of what I had this afternoon and exactly how I allocate location and jobs.
Aussie I sort of see what you're saying but but the second paragragh refers to sw and fb as the confliction illustrates. Perhaps I need to study english instead of vba ha ha.

[mdmackillop]

Worksheet module code
[VBA]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo exits
Application.EnableEvents = False


If Target.Column = 2 Then
Locats Target
End If
exits:
Application.EnableEvents = True

End Sub
[/VBA]

Standard module code
[VBA]
Sub Locats(Data As Range)
Dim Cel As Range
Dim Loc As String
Loc = Data
i = 8
Max = Application.Max(Range("C"))
Range("I:Z").Interior.ColorIndex = xlNone
Range("H:Z").ClearContents
Range("H1") = Data
For Each Cel In Rng("B")
If Cel.Value = Data.Value And Cel.Address <> Data.Address Then
i = i + 1
Cells(1, i) = Cel.Offset(, -1)
With Range(Cells(Cel.Offset(, 1) + 1, i), Cells(Cel.Offset(, 2) + 1, i))
.Interior.ColorIndex = 3
.Value = "x"
End With
End If
Next
For j = 2 To Max
If Application.CountA(Cells(j, 8).Resize(, i)) = 0 Then
Cells(j, 8) = j - 1
End If
Next
End Sub

Function Rng(col) As Range
Set Rng = Range(Cells(2, col), Cells(Rows.Count, col).End(xlUp))
End Function

[/VBA]

[mdmackillop]

A change to the original code as 185/210 would not show in your latest example
[VBA]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Locat As Range, aFr As Range, aTo As Range, c As Range
Dim FirstAddress As String
Dim Low As Long, High As Long

If Target.Column <= 4 Then
Columns("C").Interior.ColorIndex = xlNone
Set Locat = Cells(Target.Row, 2)
Set aFr = Cells(Target.Row, 3)
Set aTo = Cells(Target.Row, 4)

Locat.Resize(, 3).Interior.ColorIndex = xlNone
With Columns(2)
Set c = .Find(Locat, LookIn:=xlValues, After:=Locat)
If Not c Is Nothing Then
FirstAddress = Locat.Address
Do
Low = c.Offset(, 1)
High = c.Offset(, 2)
If aFr >= Low And aFr <= High Then
aFr.Interior.ColorIndex = 6
c.Offset(, 1).Resize(, 2).Interior.ColorIndex = 6
End If
If aTo >= Low And aTo <= High Then
aTo.Interior.ColorIndex = 6
c.Offset(, 1).Resize(, 2).Interior.ColorIndex = 6
End If
If Low >= aFr And Low <= aTo Then
aFr.Interior.ColorIndex = 35
c.Offset(, 1).Resize(, 2).Interior.ColorIndex = 6
End If
If High >= aFr And High <= aTo Then
aTo.Interior.ColorIndex = 35
c.Offset(, 1).Resize(, 2).Interior.ColorIndex = 6
End If

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
End If
End Sub

[/VBA]

[foxbat]

Thanks mdmack, i'll give this a try first chance i get today. I really appreciate this I'm sure i've been frustrating by trying to simplify everything and just not providing needed information.

Steve