How to VBA duplicate values per column with various row ranges for many columns

Tom-Ronny

New Member
Joined
Dec 13, 2013
Messages
6
Hi,

I have a challenge related to a excel sheet we are using for personnel planning.

Vertically we have several projects with action items listed row by row in the following format:
- Project 1 xxxxxx
Project management
Project Engineering
Workshop
Shipping
Etc.
- Project 2 xxxxxx
Project management
Project Engineering
Workshop
Shipping
Etc.

Horisontaly on the columns we have dates, day by day for a year +

For each day we chose from a drop down who is assigned to the action item. The problem is when there are 30-40 + projects and each have 20-30 lines of ation items it is hard to get the overview and avoid double entry. I would use conditional formating to do this, but firstly each project is separated by a line containing different formulas and I would not like the conditional formation to change these cells, and at the same time to put this up manually for each row would take a long time since there are 365 + rows.

Any idea to how a VBA code could solve this little challenge? IT would also be beneficial to have it do the check upon cell change, that way we would not need to manually run the VBA to check.


Thankfull for any help on this!
 

jsotola

Well-known Member
Joined
Nov 15, 2013
Messages
524
how many action items can be assigned to one person at any one time?

each project should have the same number of rows, maybe 30,
and if a project requires less, then hide rows

you could use a button with a macro to hide blank rows

you could then define a base range, for example, rng = range("a20", "a50", "a80", "a110", "a140" ......... )

this range could point to all the cells containing text "Project Management"

then you would use rng.offset(actionItem , timeSlot) to select all identical action items in a particular time slot

then you would check for duplicates in that time slot

use for each command to loop through the cells in the range

for each cel in rng.offset(actionItem , timeSlot) ............... next cel

of course the range could cover any number of cells in a particular timeslot

rng = range("a20:a40", "a50:a70", "a80:a100", .......... )
 

Tom-Ronny

New Member
Joined
Dec 13, 2013
Messages
6
jsotola,

The action items are basically the same but could vary slightly per project. the key beeing that when one chose a name to appoint to the action item from drop down lists in the action item - date cross the VBA code should look at all values in that spesific column for duplicates. if the chosen value exists already it should give the cell a red background.

I have tried this via using the record macro function, but hte two challenges are a. when there are lines separating the projects containing formulas that crashes the code, and b. I am having struggles to have the code do the check in a spesific column when a cell in that column (via drop down list) is changed.

Did that help in clarifying the challenge?




how many action items can be assigned to one person at any one time?

each project should have the same number of rows, maybe 30,
and if a project requires less, then hide rows

you could use a button with a macro to hide blank rows

you could then define a base range, for example, rng = range("a20", "a50", "a80", "a110", "a140" ......... )

this range could point to all the cells containing text "Project Management"

then you would use rng.offset(actionItem , timeSlot) to select all identical action items in a particular time slot

then you would check for duplicates in that time slot

use for each command to loop through the cells in the range

for each cel in rng.offset(actionItem , timeSlot) ............... next cel

of course the range could cover any number of cells in a particular timeslot

rng = range("a20:a40", "a50:a70", "a80:a100", .......... )
 

Tom-Ronny

New Member
Joined
Dec 13, 2013
Messages
6
I have a simple macro that does the trix, but the challenge as you may see is taht it only affects one column. How could I get this set up loop through and set the rule for each column at a time from column T to NT (365 days)? I have done some tries, but my challenge is to put up a code changing the T below to next column and so on.

Anyone have any idea?

Sub Macro1()
Range("T5:T33,T35:T63,T65:T93,T95:T123,T125:T153,T155:T183,T185:T213,T215:T243,T245:T273,T275:T303,T305:T333,T335:T363,T365:T393,T395:T423,T425:T453,T455:T483,T485:T513,T516,T515:T543,T545:T573,T575:T603,T605:T633,T635:T663,T665:T693,T695:T723,T725:T753").Select
Range("T725").Activate

Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetLastPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

End Sub
 

Tom-Ronny

New Member
Joined
Dec 13, 2013
Messages
6
All,

I have found a code that does what I need it to do, there is only one problem, this is static and only looks as a named range of data and operates on this. How could I rewrite the following code to look at the column I am currently changing (giving a value), and run the code and coloring on this column (maybe from active cell function? ). There will be approx. 365 active columns on the completed sheet, but I do not need the code to run on all at the same time, there will be only one active cell at the time and the code could then just check the active column for duplicates. Any ideas or suggestions?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngColor As Range
Dim rngToColor As Range
Dim CounterColors As Integer
Dim Counter As Integer
Dim rngColumn As Range
Dim rngDataFilled As Range
' cells with colors to choose from
Set rngColor = wksColor.Range("rngColorStart").Resize(wksColor.Range("SetColor").Value, 1)
' cells with data to be "colored"
Set rngToColor = wksData.Range(Range("rngDataStart"), Cells(65535, Range("rngDataStart").Column).End(xlUp))
' column with data
Set rngColumn = Columns("B")
With wksData
Set rngDataFilled = .Range(.Range("rngDataStart"), .Range("rngDataStart").Offset(10000).End(xlUp))
End With
If Not Intersect(Target, rngColumn) Is Nothing Then
Application.ScreenUpdating = False '
' Let's clear the whole data area (set background color to default)
rngDataFilled.Resize(rngDataFilled.Count + 1).Interior.ColorIndex = _
wksColor.Range("rngDefaultBackground").Interior.ColorIndex
CounterColors = 1 ' color counter reset
With rngToColor
' first cell
If Application.WorksheetFunction.CountIf(rngToColor, .Cells(1).Value) > 1 Then
.Cells(1).Interior.ColorIndex = rngColor.Cells(CounterColors).Interior.ColorIndex
CounterColors = CounterColors + 1
If CounterColors > rngColor.Count Then CounterColors = 1
End If

'more than one cell
If rngDataFilled.Count > 1 Then
' for following cells
For Counter = 2 To .Count
If Application.WorksheetFunction.CountIf(rngToColor, _
.Cells(Counter).Value) > 1 Then
If Application.WorksheetFunction.CountIf(Range("rngDataStart").Resize(Counter - 1), .Cells(Counter).Value) > 0 Then
.Cells(Counter).Interior.ColorIndex = _
rngDataFilled.Find(what:=.Cells(Counter).Value, after:=.Cells(Counter), SearchDirection:=xlPrevious, lookat:=xlWhole).Interior.ColorIndex
Else
.Cells(Counter).Interior.ColorIndex = rngColor.Cells(CounterColors).Interior.ColorIndex
CounterColors = CounterColors + 1
If CounterColors > rngColor.Count Then CounterColors = 1
End If
End If
Next Counter
End If
End With
Application.ScreenUpdating = True
End If

End Sub
 

Forum statistics

Threads
1,081,802
Messages
5,361,388
Members
400,628
Latest member
ganeshkhatri

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top