Excel “no fill”macro

thaking

New Member
Joined
Nov 12, 2013
Messages
4
I am looking for macro which will solve my issue. I have planning of machines per days, but on top of that I would like to have "overview" per machines (if there is no color fill in machine capacity planning then that means it's available for planning, otherwise is at machine planning is fill with color or text then change colour - which will mean no possible to plan)...

 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,320
Office Version
365
Platform
Windows
For the future, you will get many more potential helpers if you post any sample data in small copyable format so we do not have to manually type out the sample data to test. My signature block below has more help on that.

See if this is any use. Test in a copy of your workbook.
I have assumed a layout like this, per your image.
I have also assumed that all machine names in the bottom main table already appear in the top overview table.

Excel Workbook
ABCD
1day1day2day3
2machine1
3machine2
4machine3
5machine4
6
7day1day2day3
8machine1reservation1
9reservation2reservation1
10reservation3
11machine2reservation2reservation3
12reservation3reservation2reservation3
13reservation2reservation3
14machine3
15
16
17machine4
18reservation77
19
Machine Overview



Code:
Sub Machine_Overview()
  Dim a As Variant, b As Variant
  Dim lr As Long, lc As Long, r As Long, c As Long, k As Long
  Dim CurrMachine As String
  
  Const fr As Long = 7 '<- Main data header row
  
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  lc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  a = Range("A" & fr, Range("A" & lr)).Resize(, lc).Value
  b = Range("A1", Range("A2").End(xlDown)).Resize(, lc).Value
  For r = 2 To UBound(a)
    If Len(a(r, 1)) > 0 Then CurrMachine = a(r, 1)
    For c = 2 To UBound(a, 2)
      If Len(a(r, c)) > 0 Then
        k = 2
        Do Until b(k, 1) = CurrMachine
          k = k + 1
        Loop
        b(k, c) = 1
      End If
    Next c
  Next r
  With Range("A1").Resize(UBound(b, 1), UBound(b, 2))
    .Value = b
    .SpecialCells(xlConstants, xlNumbers).Interior.Color = 15773696
    .SpecialCells(xlConstants, xlNumbers).ClearContents
  End With
End Sub
After the above code has been run:

Excel Workbook
ABCD
1day1day2day3
2machine1
3machine2
4machine3
5machine4
6
7day1day2day3
8machine1reservation1
9reservation2reservation1
10reservation3
11machine2reservation2reservation3
12reservation3reservation2reservation3
13reservation2reservation3
14machine3
15
16
17machine4
18reservation77
19
Machine Overview
 

Watch MrExcel Video

Forum statistics

Threads
1,102,907
Messages
5,489,654
Members
407,703
Latest member
Chibuzo

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top