Question

I have a worksheet populated via a data-source which lists dates, vertically as well as horizontally.

• The dates vertically are items which
  require action.
• The dates horizontally are the coming working week dates.

At this time, all I want to do is select the corresponding column of the horizontal row based on whats found in the vertical row. I will try and do a simple diagram.

Date 3 2 1 4 5 6 7 8 9

1

3

9

In this example; I would like to select the Column of the horizontal row for 1 (if this were a new worksheet id expect it to be Column D. I also need to be able to do this by running a macro, i.e. I can’t be clicking in any cells initially.

Answer 1

Ok guys, thanks for the direction.

I was going to extend off this question. Basically what I ultimately wanted to do was plott a Gannt chart based of values fed into Excel from a datasource. I have jobs that need doing with predicted start and finish, so I open my sheet to populate the departments and dates in descending order via sql server and then run the code. It was taking a guy here 2 days to do this manually (for many departments)

Now obviously this is distinctive to me, but I found manipulating those dates a bit tricky. Ill post the entire code for the module just in case someone is looking to something similar to this at some point.

It produces this; (I have highlighted the date fields which I hide.)

Seriously, this took me all day so I sure hope it helps someone 😉
Pace

Code;

Sub One_Macro_To_Rule_Them_All()

'

'This clears the WOP sheet for formatting

    Sheets("WOP").Select
    Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, _
    Selection.Columns.Count).Select

    Selection.ClearContents
    Cells.Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells(3, 2) = "Date : " & Format(Date, "dd/mm/yyyy")



 '**************

'Copy the data to the WOP Sheet

    Sheets("Data").Select

        Rows("1:1").Select
    Range( _
        "Table_FromMyServer_view_ForwardJobsLive_WOP[[#Headers],[Job No]]") _
        .Activate
    Range("B2").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, _
   Selection.Columns.Count - 1).Select




    Selection.Copy
        Sheets("WOP").Select
        Range("A8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Range("A8").Select
      Cells(2, 2) = "Works Order Priority Sheet - " & Cells(8, 1)
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
   Selection.Columns.Count - 6).Select

    curdate = Format(Date, "dd/mm/yyyy")
    Dim dt  As String
     dt = CStr(curdate)

     'find the start of the date range

        Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
   Selection.Columns.Count - 6).Select
    Dim rngetosearch As Range
    Set rngetosearch = Selection

 rngetosearch.Find(What:="EARLIER", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
        Selection.Offset(0, 1).Resize(Selection.Rows.Count, Selection.Columns.Count + 1).Select

        dterangestart = ActiveCell



   '*********





'*************

'Format todays column as yellow
    Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
    Selection.Columns.Count - 6).Select

Dim sel As Range
Dim rangetosearch As Range
Set rangetosearch = Selection
Dim strdate As String

strdate = Date

    strdate = Format(strdate, "Short Date")

Set sel = rangetosearch.Find(What:=CDate(strdate), After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

  If sel Is Nothing = False Then
    sel.Activate
  End If


         ActiveSheet.Range(sel.Cells.Address, ActiveSheet.Range(sel.Cells.Address).End(xlDown)).Select


    With Selection.Interior
        .Color = 65535
    End With
    '***************
    'Cycle Through the rows and change the blocks
    Sheets("WOP").Select
    Selection.CurrentRegion.Select

        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, _
   Selection.Columns.Count - 0).Select

    Dim strtdte As Date
    Dim enddte As Date
    Dim actdte As Date
    Dim diff As Integer
    Dim selrnge As Range
   Set selrnge = Selection


    For Each rwrow In selrnge.Rows
        strtdte = rwrow.Cells(5)
        enddte = rwrow.Cells(7)
        actdte = rwrow.Cells(6)
        cell = rwrow.Cells(1)

        If strtdte < dterangestart Then
            'strtdte = dterangestart
            diff = DateDiff("d", dterangestart, enddte) + 1

        Else
        diff = DateDiff("d", strtdte, enddte)
        End If



        strdate = strtdte
        strdate = Format(strdate, "Short Date")

    Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
   Selection.Columns.Count - 6).Select

    Set rngetosearch = Selection
    If strtdte < dterangestart Then
    Set sel = rngetosearch.Find(What:="EARLIER", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    Else
Set sel = rngetosearch.Find(What:=CDate(strdate), After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
  End If
  If sel Is Nothing = False Then
  Dim col As Integer
  col = CInt(sel.Column)

   Selection.CurrentRegion.Select
    ActiveSheet.Cells(CInt(rwrow.Row), col).Select

    Selection.Offset(0, 0).Resize(Selection.Rows.Count, Selection.Columns.Count + diff).Select
    With Selection.Interior
    .Color = getcolor(CStr(cell))
        If actdte <> #12:00:00 AM# Then
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0.399975585192419
         Else
         .TintAndShade = 0.399975585192419
         .PatternTintAndShade = 0.399975585192419
         End If
    End With
  End If

Next


    '*************
   Range("A8").Select

End Sub