VB Macros in excel 2016 for Group by multiple columns

Question

I have following input:

I want to write a macro which will group by City first and then with Car number. In the output, I want columns from MIN(start date) to Max(end date) and each row as Unique car number. Whenever the car is occupied mark it as red otherwise green.

Desired output:

I know the logic but how to implement in macro that I don't know.

I'm reluctant to write all the code for you (and also think I may not be able to do so). But I would get two arrays with unique values (look [here](http://stackoverflow.com/questions/5890257/populate-unique-values-into-a-vba-array-from-excel)) for City and for Car, then get Max and Min values from proper columns, and then scan the arrays, and for each array value I would loop through your table and write desired results in a new sheet. — CMArg, Dec 19 '16 at 11:47

Wolfie · Accepted Answer · 2016-12-19T13:46:31.347

First off, why are you storing the "city" in a table where it is repeated? It appears to be tied to the car, if so then just store it in the car/city/dates table and use a vlookup if it must be in the other table. This will save on potential mistakes...

In answer to your question, here is how I've set up a sheet to test this, you will have to adapt the below code to suit your data layout:

Firstly, format all cells in the table as green/available. This macro will then change all the booked cells.

Sub bookings()

' This finds the number of rows in the top table (-1 for heading row)
Dim numCars As Integer
numCars = ActiveSheet.Range("A1").End(xlDown) - 1

' Tracks the active car row
Dim carRow As Integer

' Cells for first row/colum cells in tables
Dim dateCell As Range
Dim bookingCell As Range

' cycle through the bookings table (bottom)
For Each bookingCell In ActiveSheet.Range("A10:" & ActiveSheet.Range("A10").End(xlDown).Address)

    ' Find which row in top table belongs to this booking's car. Could cause error if doesn't exist!
    carRow = ActiveSheet.Columns(1).Find(what:=bookingCell.Offset(0, 1).Value, lookat:=xlWhole, LookIn:=xlValues).Row

    ' Cycle through dates in top table for comparison
    For Each dateCell In Range("C1:" & ActiveSheet.Range("C1").End(xlToRight).Address)

        ' Comparison like this will only work on dates stored properly (not as text)
        ' If this isn't working, convert your dates by multipling them by 1.
        ' This can be done in a neighbouring cell like =A1*1, then copying values
        ' See this link for details:
        ' http://stackoverflow.com/questions/6877027/how-to-convert-and-compare-a-date-string-to-a-date-in-excel

        ' If the date lies between the booking dates...
        If dateCell.Value >= bookingCell.Offset(0, 2).Value _
            And dateCell.Value <= bookingCell.Offset(0, 3).Value Then

            With ActiveSheet.Cells(carRow, dateCell.Column)


                ' Do a check that no manual change has happened
                if .value = "Available" then 

                    ' Change the text to booked and colour to red
                    .Value = "Booked"
                    .Interior.Color = RGB(200, 0, 0)

                end if

            End With

        End If

    Next dateCell

Next bookingCell

End Sub

It worked thanks. When I re-run the macro I do not want to overwrite the entries which are edited manually like: Booked --- Booked(Till 9:30 AM) — Dau_uaD, Dec 19 '16 at 13:34
In that case, before the value is changed you must include a check! I've amended my answer — Wolfie, Dec 19 '16 at 13:44

VB Macros in excel 2016 for Group by multiple columns

1 Answers1