data manipulation

[Manexcel]

I have a dataset of around 300 customer names. Each name is unique. Each name also has a unique number (can be 2 or 3 or 4 digits) e.g. customer1 51, customer2 9999, customer3 888, customer 4 7777 etc.


I have a series of meeting dates with each customer for 2018 e.g. 23-jan-18 and 27-Feb-18 and 27-Mar-18 etc. Could be 12 meetings per annum or 3 or 4 or 5 or any number in between

For each meeting there is a documented key meeting date (month number) e.g. 1 to 12. For this meeting I would like to have highlighted in BOLD.

An example dataset is below:

Customer name / customer no./ Key meet date / Meet date 1 / Meet date 2... / Meet date 12 etc
customer 1 / 51 / 1 / 01-jan-18 / 02-feb-18 / 03-mar-18 etc
customer 2 / 9999 / 3 / 02-jan-18 / 02-feb-18 / 04-mar-18 / 01-oct-18 / 01-dec-18
customer 3 / 888 / 2 / 03-jan-18 / 03-feb-18 / 01-mar-18
customer 4 / 7777 / 3 / 04-mar-18 / 01-sep-18

etc

My goal would be to have a monthly overview (1 month per sheet), by actual day of each month, for each of these meetings that occur on any given date / day. But only the numbers against each day in each month AND for each key meeting number to be in BOLD

An example of what my requested output is below:

For each month of the year...

Jan

1 51,
2 9999,
3 888,
4
31

Feb

1
2 51,9999,
3 888,
4
28

Mar

1 888
2
3 51,
4 9999, 7777,
31

etc.

Is it possible to create the above output via formula(s)?
I thank you in anticipation and for your consideration and time.

 

[Scott T]

Also not that if you want you can format the dates in column A to so only the day, custom number format d. Then you do not need to have the day of month in the column next to it. It is still the date so the code still works.

 

[Manexcel]

Scott have rerun the procedure you very kindly provided. The meeting numbers appear to align to the correct months. This is great.

I now also get BOLD customer numbers but unfortunately in the wrong months. For example (taken from previous test data)

A1000 should be bold in Jan18 not Nov17
A160 should be bold in Jan18 not Nov17
A214 should be bold in Jan18 not Nov17.

I have simplified the test data (I hope). Each customer number has a min. of 10 meeting dates. the key meeting dates are highlighted in BOLD which should correspond to the key meet date column. An example is below.
NOV17 would have 10 meeting numbers across the month with two in BOLD
Feb18 would also have 10 meeting numbers across the month with only one in BOLD

Customer number A51 has meeting dates from Nov17 to Apr18 and Oct18 to Jan19. The key meeting date is 11. Therefore, is it possible to BOLD the meeting date for Nov meeting dates? and likewise for other numbers in the list.

no

Ac number

Ac name

key meet date

Meet date 1

Meet date 2

Meet date 3

Meet date 4

Meet date 5

Meet date 6

Meet date 7

Meet date 8

Meet date 9

Meet date 10

1

A51

Customer 1

11

01-Nov-17

01-Dec-17

01-Jan-18

01-Feb-18

01-Mar-18

01-Apr-18

01-Oct-18

01-Nov-18

01-Dec-18

01-Jan-19

2

A160

Customer 2

12

05-Nov-17

05-Dec-17

05-Jan-18

05-Feb-18

05-Mar-18

05-Apr-18

05-Oct-18

05-Nov-18

05-Dec-18

05-Jan-19

3

A214

Customer 3

1

09-Nov-17

09-Dec-17

09-Jan-18

09-Feb-18

09-Mar-18

09-Apr-18

09-Oct-18

09-Nov-18

09-Dec-18

09-Jan-19

4

A276

Customer 4

2

13-Nov-17

13-Dec-17

13-Jan-18

13-Feb-18

13-Mar-18

13-Apr-18

13-Oct-18

13-Nov-18

13-Dec-18

13-Jan-19

5

A433

Customer 5

3

17-Nov-17

17-Dec-17

17-Jan-18

17-Feb-18

17-Mar-18

17-Apr-18

17-Oct-18

17-Nov-18

17-Dec-18

17-Jan-19

6

A453

Customer 6

4

21-Nov-17

21-Dec-17

21-Jan-18

21-Feb-18

21-Mar-18

21-Apr-18

21-Oct-18

21-Nov-18

21-Dec-18

21-Jan-19

7

A650

Customer 7

10

25-Nov-17

25-Dec-17

25-Jan-18

25-Feb-18

25-Mar-18

25-Apr-18

25-Oct-18

25-Nov-18

25-Dec-18

25-Jan-19

8

A697

Customer 8

11

29-Nov-17

29-Dec-17

29-Jan-18

02-Feb-18

29-Mar-18

29-Apr-18

29-Oct-18

29-Nov-18

29-Dec-18

29-Jan-19

9

A1000

Customer 9

12

03-Nov-17

03-Dec-17

02-Jan-18

03-Feb-18

02-Mar-18

02-Apr-18

02-Oct-18

02-Nov-18

02-Dec-18

02-Jan-19

10

A1024

Customer 10

1

04-Nov-17

04-Dec-17

03-Jan-18

04-Feb-18

03-Mar-18

03-Apr-18

03-Oct-18

03-Nov-18

03-Dec-18

03-Jan-19

<colgroup><col><col><col><col><col span="9"><col></colgroup><tbody>
</tbody>

Scott, I trust the above makes sense and thanks again for all your help.

 

[Scott T]

So the key meet date is the month of the meeting not the meet number?

 

[Manexcel]

HI Scott, thank you for responding so quickly.

The 'key meet date' number is the month of the customer key meeting. Of course there are other meetings throughout the 'period'. All meeting dates for A51 should be in their respective month sheets but the 'key meet date' will be in BOLD.

So if Customer number A51 has meeting dates from Nov17 to Apr18 and Oct18 to Jan19 and the key meeting date is 11 (which is Nov) I would be looking for A51 to be recorded in sheets

Nov17 to Apr18 and Oct18 to Jan19, and​

as the 'key meeting date' is 11(Nov) this will be in BOLD.

Has the above assisted?​

it is not the meet number.

Thanks again.

 

[Scott T]

Try

Sub meetings()
Dim ws As Worksheet
Dim janws As Worksheet
Dim febws As Worksheet
Dim marws As Worksheet
Dim aprws As Worksheet
Dim mayws As Worksheet
Dim junws As Worksheet
Dim julws As Worksheet
Dim augws As Worksheet
Dim sepws As Worksheet
Dim octws As Worksheet
Dim novws As Worksheet
Dim decws As Worksheet
Dim lr As Long
Dim lc As Long
Dim rng As Range
Dim cell As Range
Dim w As Worksheet
Dim wsq As Worksheet
Dim mws As Worksheet

Set ws = Sheets("Sheet1")
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Set rng = ws.Range(ws.Cells(2, 5), ws.Cells(lr, lc))
Application.ScreenUpdating = False
For Each w In ActiveWorkbook.Worksheets
    If w.Name <> "Sheet1" Then
        w.Range("D2.D32").ClearContents 'clear columns in monthly sheets so new data can be entered
        w.Range("D2.D32").ClearFormats 'clear columns in monthly sheets of formatting
    End If
Next w

'for Jan
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 1 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Jan" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Jen" & myyear & " does not exist please create sheet")
                Exit Sub
            End If
            If cell = Sheets("Jan" & myyear).Cells(x, 1) Then
                Sheets("Jan" & myyear).Cells(x, "D") = Sheets("Jan" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Jan" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Jan" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Jan" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Feb
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 2 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Feb" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Feb" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Feb" & myyear).Cells(x, 1) Then
                Sheets("Feb" & myyear).Cells(x, "D") = Sheets("Feb" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Feb" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Feb" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Feb" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Mar
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 3 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Mar" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Mar" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Mar" & myyear).Cells(x, 1) Then
                Sheets("Mar" & myyear).Cells(x, "D") = Sheets("Mar" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Mar" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Mar" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Mar" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Apr
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 4 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Apr" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Apr" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Apr" & myyear).Cells(x, 1) Then
                Sheets("Apr" & myyear).Cells(x, "D") = Sheets("Apr" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Apr" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Apr" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Apr" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for May
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 5 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("May" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "May" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("May" & myyear).Cells(x, 1) Then
                Sheets("May" & myyear).Cells(x, "D") = Sheets("May" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("May" & myyear).Cells(x, "D"), 1) = "," Then Sheets("May" & myyear).Cells(x, "D") = Application.Substitute(Sheets("May" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Jun
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 6 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Jun" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Jun" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Jun" & myyear).Cells(x, 1) Then
                Sheets("Jun" & myyear).Cells(x, "D") = Sheets("Jun" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Jun" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Jun" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Jun" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Jul
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 7 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Jul" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Jul" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Jul" & myyear).Cells(x, 1) Then
                Sheets("Jul" & myyear).Cells(x, "D") = Sheets("Jul" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Jul" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Jul" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Jul" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Aug
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 8 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Aug" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Aug" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Aug" & myyear).Cells(x, 1) Then
                Sheets("Aug" & myyear).Cells(x, "D") = Sheets("Aug" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Aug" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Aug" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Aug" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Sept
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 9 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Sept" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Sept" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Sept" & myyear).Cells(x, 1) Then
                Sheets("Sept" & myyear).Cells(x, "D") = Sheets("Sept" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Sept" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Sept" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Sept" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Oct
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 10 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Oct" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Oct" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Oct" & myyear).Cells(x, 1) Then
                Sheets("Oct" & myyear).Cells(x, "D") = Sheets("Oct" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Oct" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Oct" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Oct" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Nov
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 11 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Nov" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Nov" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Nov" & myyear).Cells(x, 1) Then
                Sheets("Nov" & myyear).Cells(x, "D") = Sheets("Nov" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Nov" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Nov" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Nov" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x
'for Dec
For x = 2 To 32
    For Each cell In rng
        If cell <> "" And Month(cell) = 12 Then
            myyear = Right(Year(cell), 2)
            Set wsq = Nothing
            On Error Resume Next
            Set wsq = Sheets("Dec" & myyear)
            On Error GoTo 0
            If wsq Is Nothing Then
                MsgBox ("Sheet " & "Dec" & myyear & " does not exist please create sheet")
                Exit Sub
            End If

            If cell = Sheets("Dec" & myyear).Cells(x, 1) Then
                Sheets("Dec" & myyear).Cells(x, "D") = Sheets("Dec" & myyear).Cells(x, "D") & ", " & ws.Cells(cell.Row, 2)
                If Left(Sheets("Dec" & myyear).Cells(x, "D"), 1) = "," Then Sheets("Dec" & myyear).Cells(x, "D") = Application.Substitute(Sheets("Dec" & myyear).Cells(x, "D"), ", ", "")
            End If
        End If
    Next cell
Next x

'to bold key meeting
For y = 2 To lr
    cusnumber = ws.Cells(y, 2)
    cuslen = Len(ws.Cells(y, 2))
    lkc = ws.Cells(y, Columns.Count).End(xlToLeft).Column
    
    For m = 5 To lkc
        keymonth = ws.Cells(y, 4)
        If keymonth = Month(ws.Cells(y, m)) Then
            keydate = ws.Cells(y, m)
            keyyear = Year(ws.Cells(y, m))
        End If
        If keydate = "" Then GoTo invalidkeydate
        
    Select Case keymonth
        Case Is = 1
        keymonth = "Jan"
        Case Is = 2
        keymonth = "Feb"
        Case Is = 3
        keymonth = "Mar"
        Case Is = 4
        keymonth = "Apr"
        Case Is = 5
        keymonth = "May"
        Case Is = 6
        keymonth = "Jun"
        Case Is = 7
        keymonth = "Jul"
        Case Is = 8
        keymonth = "Aug"
        Case Is = 9
        keymonth = "Sept"
        Case Is = 10
        keymonth = "Oct"
        Case Is = 11
        keymonth = "Nov"
        Case Is = 12
        keymonth = "Dec"
    End Select
    
            mrow = Application.Match(CLng(keydate), Sheets(keymonth & Right(keyyear, 2)).Range("A1:A32"), 0)
            kstart = InStr(Sheets(keymonth & Right(keyyear, 2)).Cells(mrow, 4), cusnumber)
            Sheets(keymonth & Right(keyyear, 2)).Cells(mrow, 4).Characters(kstart, cuslen).Font.Bold = True
            keydate = ""
            keymonth = ""
        
invalidkeydate:
    Next m
    
Next y
Application.ScreenUpdating = True
End Sub

 

[stunnrock]

If you are still interested in doing it with formulae:

I have assumed that your data is in Sheet1!A2:O301, and that you will have no more than 6 meetings per day.
On Sheet2, cell B2 is used for over-riding the month (with a number or 3-letter name), and C2 is used for over-riding the year. If both are empty, the current month and year are used.

In B3: =IF($B$2<>"",IF(ISNUMBER($B$2),$B$2,MATCH($B$2,INDEX(TEXT(DATE(1904,ROW(INDIRECT("R1:R12")),1),"mmm"),),0)),MONTH(TODAY()))

In C3: =IF($C$2="",$C$3,$C$2)

In A5: =TEXT(DATE(1904,B3,1),"mmm")

In A6: =IF(ROWS($A$6:$F6)>DAY(DATE($C$3,$B$3+1,0)),"-",ROWS($A$6:$F6))

In B6 - this needs to be array-entered (Ctrl+Shift+Enter, instead of just enter):
=IFERROR(INDEX(Sheet1!$B:$B,SMALL(IF(ISNUMBER(FIND(DATE($C$3,$B$3,$A6)&" ",Sheet1!$D$2:$D$301&" "&Sheet1!$E$2:$E$301&" "&Sheet1!$F$2:$F$301&" "&Sheet1!$G$2:$G$301&" "&Sheet1!$H$2:$H$301&" "&Sheet1!$I$2:$I$301&" "&Sheet1!$J$2:$J$301&" "&Sheet1!$K$2:$K$301&" "&Sheet1!$L$2:$L$301&" "&Sheet1!$M$2:$M$301&" "&Sheet1!$N$2:$N$301&" "&Sheet1!$O$2:$O$301&" ")),ROW(Sheet1!$D$2:$D$301)),COLUMNS($B:B))),"-")

Copy B6 into C6:G6, then copy A6:G6 into A7:G36

To get bold highlighting, select A6:G36 and open Conditional Formatting. Then create a new rule with the rule type "Use a formula...", and the formula:
=ISNUMBER(MATCH(B6&$B$3,INDEX(Sheet1!$B$2:$B$301&Sheet1!$C$2:$C$301,),0))
Change the formatting to Bold, and you're done.

 

[stunnrock]

Quick correction. Formula in C3 should be: =IF($C$2="",YEAR(TODAY()),$C$2)

 

[Manexcel]

Many thanks for the amended procedure. I have used on my test data and 'live' dataset (+300 customers) and all appears to be working just fine. (I am now checking the output). Thank you very much for all your time, effort and patience in my issue. Very much appreciated. Great job.

A further question if I may...

When I migrate to my 'live' version there could be other worksheets in the workbook and have noticed the procedure appears to delete contents and formatting (range D2:d32) from ANY sheet that is <> to sheet1 . Can the procedure be amended to overcome? I know we need clean /empty "month" worksheets but I don't want to delete and reformat other worksheets in the workbook.

Also, can you clarify what is the best sheet the code needs to be placed in.

Thanks again.

 

[Scott T]

you can add sheets to the if statement

If w.Name <> "Sheet1" And w.Name <> "Sheet7" Then

Depending on the name of the other sheets you could test if the sheet is one of the month sheets by what the first 3 of the sheet name is. (I have not included all the months here)

If Left(w.Name, 3) = "Jan" Or Left(w.Name, 3) = "Feb" Or Left(w.Name, 3) = "Mar" Or Left(w.Name, 3) = "Apr"... Then

The code can go into a module

 

[Manexcel]

Scott, thank you so much for the code. I have added (test the month sheet option) and all appears to be working ok. (I am still in the process of testing and checking). Once again a great job. Thank you.

On a slightly related matter... If I perform formatting on the month sheets e.g. shade alternate lines via conditional formatting and run the procedure it does not work correctly i.e. it places customer numbers on different dates and performs extra BOLD on customer numbers. As soon as I revert to no formatting all is ok.

Is this what I could have expected?

Thank you.