Flipping values in excel to column titles

Dreamteam

New Member
Joined
Feb 22, 2018
Messages
28
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I try to reserve any questions to this forum that are a little challenging - so apologies for the following as I really should know how to do this. In short, a taxi company has daily contracts and simply add which taxis took the job - at the end of the month the drivers get paid. The contracts are at the top, the dates on the side and whichever taxi does the job gets entered into the data in the spread sheet (taxis 3,5,6,7,8,14 or 15). All I want to do is flip this information so that the taxi references are at the top and the contracts are in the spread sheet. I have highlighted a possible scenario where one of the drivers complete more that 2 jobs in the day - I thought that this would be the only difficult part but for me I am struggling (looking at this I don't think it has come out highlighted). I have tried using Tables/Pivot Tables but to no avail.

Any help would be much appreciated.

Many thanks

Dt

CURRENT STATE

[TABLE="width: 1010"]
<colgroup><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]DATE[/TD]
[TD]DAY[/TD]
[TD]AM/PM[/TD]
[TD]COSAWES[/TD]
[TD]BASS ACC[/TD]
[TD]SWAN MONG[/TD]
[TD]PL PL SAINS[/TD]
[TD]BERKLEY COTT[/TD]
[TD]PL PL DRAC[/TD]
[TD]TREGEW[/TD]
[/TR]
[TR]
[TD="align: right"]01/02/2019[/TD]
[TD]FRI[/TD]
[TD]AM[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]01/02/2019[/TD]
[TD]FRI[/TD]
[TD]PM[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]02/02/2019[/TD]
[TD]SAT[/TD]
[TD]AM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]02/02/2019[/TD]
[TD]SAT[/TD]
[TD]PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]03/02/2019[/TD]
[TD]SUN[/TD]
[TD]AM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]03/02/2019[/TD]
[TD]SUN[/TD]
[TD]PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]04/02/2019[/TD]
[TD]MON[/TD]
[TD]AM[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]3[/TD]
[TD][/TD]
[TD="align: right"]5[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]04/02/2019[/TD]
[TD]MON[/TD]
[TD]PM[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]05/02/2019[/TD]
[TD]TUE[/TD]
[TD]AM[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD="align: right"]05/02/2019[/TD]
[TD]TUE[/TD]
[TD]PM[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]5[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]



WOULD I IMAGINE IT TO LOOK LIKE


[TABLE="width: 881"]
<colgroup><col><col span="2"><col span="2"><col><col><col><col><col></colgroup><tbody>[TR]
[TD]DATE[/TD]
[TD]DAY[/TD]
[TD]AM/PM[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"]15[/TD]
[/TR]
[TR]
[TD="align: right"]01/02/2019[/TD]
[TD]FRI[/TD]
[TD]AM[/TD]
[TD][/TD]
[TD]COSAWES[/TD]
[TD][/TD]
[TD]SWAN MONGL[/TD]
[TD][/TD]
[TD]BASS ACC[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]01/02/2019[/TD]
[TD]FRI[/TD]
[TD]PM[/TD]
[TD]SWAN MONGL[/TD]
[TD]COSAWES[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]BASS ACC[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]02/02/2019[/TD]
[TD]SAT[/TD]
[TD]AM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]02/02/2019[/TD]
[TD]SAT[/TD]
[TD]PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]03/02/2019[/TD]
[TD]SUN[/TD]
[TD]AM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]03/02/2019[/TD]
[TD]SUN[/TD]
[TD]PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]04/02/2019[/TD]
[TD]MON[/TD]
[TD]AM[/TD]
[TD]SWAN MONGL[/TD]
[TD]BERK COTT[/TD]
[TD][/TD]
[TD]COSAWES[/TD]
[TD][/TD]
[TD][/TD]
[TD]BASS ACC[/TD]
[/TR]
[TR]
[TD="align: right"]04/02/2019[/TD]
[TD]MON[/TD]
[TD]PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]COSAWES[/TD]
[TD][/TD]
[TD]SWAN MONGL[/TD]
[TD]BASS ACC[/TD]
[/TR]
[TR]
[TD="align: right"]05/02/2019[/TD]
[TD]TUE[/TD]
[TD]AM[/TD]
[TD]PL PL SAINS[/TD]
[TD]SWAN MONGL[/TD]
[TD][/TD]
[TD]BASS ACC[/TD]
[TD]COSAWES[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]05/02/2019[/TD]
[TD]TUE[/TD]
[TD]PM[/TD]
[TD]PL PL SAINS[/TD]
[TD]SWAN MONGL[/TD]
[TD][/TD]
[TD]BASS ACC[/TD]
[TD]COSAWES[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]05/02/2019[/TD]
[TD]TUE[/TD]
[TD]PM[/TD]
[TD][/TD]
[TD]BERK COTT[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Try this:-
NB:- The word "DATE" in column "A" data is assumed to start in "A1".
NB:- This code will alter your Data !!
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Jan20
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Taxi [COLOR="Navy"]As[/COLOR] Variant, P [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Taxi = Array(3, 5, 6, 7, 8, 14, 15)
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp)).Resize(, Lst)

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
        
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, nRng [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Rng.ClearContents
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Taxi
        c = c + 1
        [COLOR="Navy"]If[/COLOR] .exists(Val(R)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] .Item(Val(R))
                Cells(P.Row, c + 3) = Cells(1, P.Column).Value
            [COLOR="Navy"]Next[/COLOR] P
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
      Range("D1").Resize(, UBound(Taxi) + 1) = Taxi
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick

Many many thanks for this

Why can't I write code off the bat like this!

Your code works great - apart from when the taxi completes more than 2 jobs for the day - for example on 05/02/2019 Taxi 5 completes SWAN MONGL on both am and pm and another job in the pm.

Bit tricky I think

Many thanks

Dt
 
Last edited:
Upvote 0
Try this enhanced code for duplicates jobs in any line
Run the code from the activesheet (data sheet) for results on sheet2.
Code:
[COLOR="Navy"]Sub[/COLOR] MG27Jan07
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, P [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] dic [COLOR="Navy"]As[/COLOR] Object, nRng [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] ActiveSheet
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbTextCompare
oMax = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    c = c + oMax
  oMax = 0
 [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    Dn.Resize(, Lst).Copy .Cells(c, 1)
    [COLOR="Navy"]Set[/COLOR] nRng = .Cells(c, 1).Resize(, Lst)
    dic.RemoveAll
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] nRng
        [COLOR="Navy"]If[/COLOR] R.Column > 3 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] R.Value <> "" [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Not dic.Exists(R.Value) [COLOR="Navy"]Then[/COLOR]
                    dic.Add R.Value, 0
                [COLOR="Navy"]Else[/COLOR]
                    dic(R.Value) = dic(R.Value) + 1
                    oMax = Application.Max(dic(R.Value), oMax)
                    nRng(1).Resize(, 3).Copy nRng(1).Offset(dic(R.Value))
                    R.Cut R.Offset(dic(R.Value))
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] R
oMax = oMax + 1
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] Dn
namchange
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]Sub[/COLOR] namchange()
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Taxi [COLOR="Navy"]As[/COLOR] Variant, P [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] dic [COLOR="Navy"]As[/COLOR] Object
Taxi = Array(3, 5, 6, 7, 8, 14, 15)
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
    [COLOR="Navy"]Set[/COLOR] Rng = Rng.Offset(, 1).Resize(, Lst)


[COLOR="Navy"]Set[/COLOR] dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            dic.Add Dn.Value, Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] dic(Dn.Value) = Union(dic(Dn.Value), Dn)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, nRng [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Rng.ClearContents
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Taxi
        c = c + 1
        [COLOR="Navy"]If[/COLOR] dic.Exists(Val(R)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] dic(Val(R))
                .Cells(P.Row, c + 3) = .Cells(1, P.Column).Value
            [COLOR="Navy"]Next[/COLOR] P
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
.Range("D1").Resize(, UBound(Taxi) + 1) = Taxi
.UsedRange.Columns.AutoFit
.UsedRange.Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Mick - I don't know what to say. Well I do - 1) Thank you so much for this. I got a bit obsessed with it and I have been considering it for all of yesterday and yesterday evening. 2) How can I learn to this level of coding? I seem to spend forever on even the most basic problems.

Anyway - thank you once again :~)

Dt
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top