data manipulation

Manexcel · Dec 11, 2017

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.

Manexcel · Dec 23, 2017

Scott thank you so much for coming back to me. Much appreciated.

I have run your procedure and I get a message "No date for the key meeting". The customer numbers e.g. '51' or '9999' or '888' or '7777' did not get highlighted in bold.

In addition on sheet1 (master data) in col E - Meet date 1 (the first of the 12 meet date columns) the first 31 entries get deleted each time i run the procedure.

In my sheet1 I have the following (the key meeting date is in Col D:

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

Also, for each customer name / customer no. there may not, as yet, be 12 meeting dates for each. I populated sheet1 to ensure ALL customer names / customer no. had a meeting date (31-dec-99) but I still got the message "No date for the key meeting".

For each month sheet the 'customer no.' get populated, via your the procedure, from col E (we changed this last time around (?)) This all works fine.

I trust the above assists?

thanks again

Scott T · Dec 23, 2017

If you have 3 as the key meeting but only have two meetings then you do not have a valid key meeting. If you still want the rest of the code to run then I have changed the code to skip that key meeting but still have a message box to let you know you have an invalid key meeting. You can comment out the line or remove it if you do not want the notification.

Code:

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


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, 4), ws.Cells(lr, lc))


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


'jan
For y = 2 To lr
    keydate = ws.Cells(y, 3).Offset(, ws.Cells(y, 3))
    If keydate = "" Then
        MsgBox ("No date for the key meeting") ' comment out or remove if you do not want the message box
        GoTo invalidkeydate      
        
    End If
    keyyear = Year(keydate)
    keymonth = Month(keydate)
    cusnumber = ws.Cells(y, 2)
    cuslen = Len(ws.Cells(y, 2))
    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
    
invalidkeydate:
Next y


End Sub

Manexcel · Dec 27, 2017

Hi Scott I have run the amended procedure you very kindly provided. Unfortunately, I get an error message;

Run time error 13:
Type mismatch.

In running the debug option this appears to be in the 'bold key meeting ' step as all meeting dates appear to be populated ok.

Any thoughts and thanks again for all your efforts.

Scott T · Dec 27, 2017

What is the actual line is highlighted when you debug?

Manexcel · Dec 27, 2017

keydate = ws.Cells(y, 3).Offset(, ws.Cells(y, 3)

Scott T · Dec 27, 2017

What column is the Key meeting date in on your master data sheet? I think I may have used the wrong column.

Manexcel · Dec 27, 2017

column 4 holds the key meeting date.

My master sheet is called "sheet1" at present

The column is headed by:

Key meet date

Each row contains a number between 1-12 which correspond to the months of the year.

Scott T · Dec 27, 2017

Change the 3 to a 4

Code:

[FONT=Arial][SIZE=2][COLOR=#000000]keydate = ws.Cells(y, 4).Offset(, ws.Cells(y, 4)[/COLOR][/SIZE][/FONT]

Manexcel · Dec 28, 2017

Hi Scott, changing the procedure as requested has overcome the error message of;

Run time error 13:
Type mismatch.

The procedure now runs but in the to bold key meeting step of the procedure I get a message;
"No date for the key meeting". - This message I receive for only 7 times (I have run several times) I reply ok and then the following message;

Run time error 13:
Type mismatch.

In reviewing each months meetings none of the key meeting numbers are in BOLD.

In addition, the procedure deletes data in my master data sheet called sheet1 but only Col E which is the first set of meeting dates but only the first 31 rows of 350 (?)

To clarify my master data layout sheet called sheet1;

[TABLE="width: 682"]
<tbody>[TR]
[TD]no
[/TD]
[TD]Customer number
[/TD]
[TD]Customer name
[/TD]
[TD]key meet date
[/TD]
[TD]Meet date 1
[/TD]
[TD]Meet date 2
[/TD]
[TD]Meet date 3
[/TD]
[TD]Meet date 4
[/TD]
[TD]Meet date 5
[/TD]
[TD]etc
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]A51
[/TD]
[TD]Customer1
[/TD]
[TD]10
[/TD]
[TD]28-Nov-17
[/TD]
[TD]26-Dec-17
[/TD]
[TD]23-Jan-18
[/TD]
[TD]27-Feb-18
[/TD]
[TD]27-Mar-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]A160
[/TD]
[TD]Customer2
[/TD]
[TD]1
[/TD]
[TD]21-Nov-17
[/TD]
[TD]16-Jan-18
[/TD]
[TD]20-Feb-18
[/TD]
[TD]20-Mar-18
[/TD]
[TD]17-Apr-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]A214
[/TD]
[TD]Customer3
[/TD]
[TD]1
[/TD]
[TD]21-Nov-17
[/TD]
[TD]16-Jan-18
[/TD]
[TD]20-Mar-18
[/TD]
[TD]18-Sep-18
[/TD]
[TD]20-Nov-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]A276
[/TD]
[TD]Customer4
[/TD]
[TD]12
[/TD]
[TD]07-Dec-17
[/TD]
[TD]01-Feb-18
[/TD]
[TD]01-Mar-18
[/TD]
[TD]05-Apr-18
[/TD]
[TD]03-May-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]A433
[/TD]
[TD]Customer5
[/TD]
[TD]10
[/TD]
[TD]20-Nov-17
[/TD]
[TD]18-Dec-17
[/TD]
[TD]19-Feb-18
[/TD]
[TD]19-Mar-18
[/TD]
[TD]16-Apr-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]A453
[/TD]
[TD]Customer6
[/TD]
[TD]6
[/TD]
[TD]09-Nov-17
[/TD]
[TD]26-Apr-18
[/TD]
[TD]14-Jun-18
[/TD]
[TD]13-Sep-18
[/TD]
[TD]08-Nov-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]A650
[/TD]
[TD]Customer7
[/TD]
[TD]10
[/TD]
[TD]14-Nov-17
[/TD]
[TD]12-Dec-17
[/TD]
[TD]09-Jan-18
[/TD]
[TD]13-Feb-18
[/TD]
[TD]13-Mar-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]A697
[/TD]
[TD]Customer8
[/TD]
[TD]5
[/TD]
[TD]15-Nov-17
[/TD]
[TD]20-Dec-17
[/TD]
[TD]21-Feb-18
[/TD]
[TD]21-Mar-18
[/TD]
[TD]18-Apr-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]A1000
[/TD]
[TD]Customer9
[/TD]
[TD]1
[/TD]
[TD]16-Nov-17
[/TD]
[TD]18-Jan-18
[/TD]
[TD]15-Feb-18
[/TD]
[TD]15-Mar-18
[/TD]
[TD]20-Sep-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]A1024
[/TD]
[TD]Customer10
[/TD]
[TD]10
[/TD]
[TD][/TD]
[TD]27-Dec-17
[/TD]
[TD]24-Jan-18
[/TD]
[TD]28-Feb-18
[/TD]
[TD]28-Mar-18
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]etc
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]

To clarify my output for each months sheets called Nov17 or Jan18 or Jan19 etc. is;

[TABLE="width: 609"]
<tbody>[TR]
[TD][/TD]
[TD]Day of Month
[/TD]
[TD]Day of week
[/TD]
[TD]No in Month
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]01/01/2018
[/TD]
[TD]1
[/TD]
[TD]Mon
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]02/01/2018
[/TD]
[TD]2
[/TD]
[TD]Tue
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]03/01/2018
[/TD]
[TD]3
[/TD]
[TD]Wed
[/TD]
[TD][/TD]
[TD]A6230, A6484
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]04/01/2018
[/TD]
[TD]4
[/TD]
[TD]Thu
[/TD]
[TD][/TD]
[TD="colspan: 2"]A2342, A4220, A8913
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]05/01/2018
[/TD]
[TD]5
[/TD]
[TD]Fri
[/TD]
[TD][/TD]
[TD]A8527
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]06/01/2018
[/TD]
[TD]6
[/TD]
[TD]Sat
[/TD]
[TD][/TD]
[TD="colspan: 4"]A4456, A4738, A5217, A5388, A6718, A6804
[/TD]
[/TR]
[TR]
[TD]07/01/2018
[/TD]
[TD]7
[/TD]
[TD]Sun
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]08/01/2018
[/TD]
[TD]8
[/TD]
[TD]Mon
[/TD]
[TD][/TD]
[TD="colspan: 3"]A1312, A1977, A7143, A7975, A8005
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]09/01/2018
[/TD]
[TD]9
[/TD]
[TD]Tue
[/TD]
[TD][/TD]
[TD]A650, A8871
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Scott, I trust the above is helpful to you. Many thanks as always for your time in trying to resolve my issue.

Scott T · Dec 28, 2017

Change this line

Code:

Set rng = ws.Range(ws.Cells(2, 4), ws.Cells(lr, lc))

To

Code:

Set rng = ws.Range(ws.Cells(2, 5), ws.Cells(lr, lc))

When I run the code with the above change with sheet1 like this
Excel 2010[TABLE="class: grid, width: 990"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[/TR]
[TR]
[TD="align: center"]1
[/TD]
[TD]no
[/TD]
[TD]Customer number
[/TD]
[TD]Customer name
[/TD]
[TD]key meet date
[/TD]
[TD]Meet date 1
[/TD]
[TD]Meet date 2
[/TD]
[TD]Meet date 3
[/TD]
[TD]Meet date 4
[/TD]
[TD]Meet date 5
[/TD]
[TD]Meet date 6
[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: right"]1
[/TD]
[TD]A51
[/TD]
[TD]Customer1
[/TD]
[TD="align: right"]10
[/TD]
[TD="align: right"]28-Nov-17
[/TD]
[TD="align: right"]26-Dec-17
[/TD]
[TD="align: right"]23-Jan-18
[/TD]
[TD="align: right"]27-Feb-18
[/TD]
[TD="align: right"]27-Mar-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]3
[/TD]
[TD="align: right"]2
[/TD]
[TD]A160
[/TD]
[TD]Customer2
[/TD]
[TD="align: right"]1
[/TD]
[TD="align: right"]21-Nov-17
[/TD]
[TD="align: right"]16-Jan-18
[/TD]
[TD="align: right"]20-Feb-18
[/TD]
[TD="align: right"]20-Mar-18
[/TD]
[TD="align: right"]17-Apr-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD="align: right"]3
[/TD]
[TD]A214
[/TD]
[TD]Customer3
[/TD]
[TD="align: right"]1
[/TD]
[TD="align: right"]21-Nov-17
[/TD]
[TD="align: right"]16-Jan-18
[/TD]
[TD="align: right"]20-Mar-18
[/TD]
[TD="align: right"]18-Sep-18
[/TD]
[TD="align: right"]20-Nov-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]5
[/TD]
[TD="align: right"]4
[/TD]
[TD]A276
[/TD]
[TD]Customer4
[/TD]
[TD="align: right"]12
[/TD]
[TD="align: right"]7-Dec-17
[/TD]
[TD="align: right"]1-Feb-18
[/TD]
[TD="align: right"]1-Mar-18
[/TD]
[TD="align: right"]5-Apr-18
[/TD]
[TD="align: right"]3-May-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]6
[/TD]
[TD="align: right"]5
[/TD]
[TD]A433
[/TD]
[TD]Customer5
[/TD]
[TD="align: right"]10
[/TD]
[TD="align: right"]20-Nov-17
[/TD]
[TD="align: right"]18-Dec-17
[/TD]
[TD="align: right"]19-Feb-18
[/TD]
[TD="align: right"]19-Mar-18
[/TD]
[TD="align: right"]16-Apr-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]7
[/TD]
[TD="align: right"]6
[/TD]
[TD]A453
[/TD]
[TD]Customer6
[/TD]
[TD="align: right"]6
[/TD]
[TD="align: right"]9-Nov-17
[/TD]
[TD="align: right"]26-Apr-18
[/TD]
[TD="align: right"]14-Jun-18
[/TD]
[TD="align: right"]13-Sep-18
[/TD]
[TD="align: right"]8-Nov-18
[/TD]
[TD="align: right"]12/7/2018
[/TD]
[/TR]
[TR]
[TD="align: center"]8
[/TD]
[TD="align: right"]7
[/TD]
[TD]A650
[/TD]
[TD]Customer7
[/TD]
[TD="align: right"]10
[/TD]
[TD="align: right"]14-Nov-17
[/TD]
[TD="align: right"]12-Dec-17
[/TD]
[TD="align: right"]9-Jan-18
[/TD]
[TD="align: right"]13-Feb-18
[/TD]
[TD="align: right"]13-Mar-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]9
[/TD]
[TD="align: right"]8
[/TD]
[TD]A697
[/TD]
[TD]Customer8
[/TD]
[TD="align: right"]5
[/TD]
[TD="align: right"]15-Nov-17
[/TD]
[TD="align: right"]20-Dec-17
[/TD]
[TD="align: right"]21-Feb-18
[/TD]
[TD="align: right"]21-Mar-18
[/TD]
[TD="align: right"]18-Apr-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]10
[/TD]
[TD="align: right"]9
[/TD]
[TD]A1000
[/TD]
[TD]Customer9
[/TD]
[TD="align: right"]1
[/TD]
[TD="align: right"]16-Nov-17
[/TD]
[TD="align: right"]18-Jan-18
[/TD]
[TD="align: right"]15-Feb-18
[/TD]
[TD="align: right"]15-Mar-18
[/TD]
[TD="align: right"]20-Sep-18
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]11
[/TD]
[TD="align: right"]10
[/TD]
[TD]A1024
[/TD]
[TD]Customer10
[/TD]
[TD="align: right"]10
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]27-Dec-17
[/TD]
[TD="align: right"]24-Jan-18
[/TD]
[TD="align: right"]28-Feb-18
[/TD]
[TD="align: right"]28-Mar-18
[/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]

Sheet1

and the months sheets like this
Excel 2010[TABLE="class: grid, width: 450"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[/TR]
[TR]
[TD="align: center"]1
[/TD]
[TD="align: right"][/TD]
[TD]Day of month
[/TD]
[TD]day of week
[/TD]
[TD]no in month
[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD="align: right"]11/1/2017
[/TD]
[TD="align: right"]1
[/TD]
[TD="align: right"]Wed
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]3
[/TD]
[TD="align: right"]11/2/2017
[/TD]
[TD="align: right"]2
[/TD]
[TD="align: right"]Thu
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD="align: right"]11/3/2017
[/TD]
[TD="align: right"]3
[/TD]
[TD="align: right"]Fri
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]5
[/TD]
[TD="align: right"]11/4/2017
[/TD]
[TD="align: right"]4
[/TD]
[TD="align: right"]Sat
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]6
[/TD]
[TD="align: right"]11/5/2017
[/TD]
[TD="align: right"]5
[/TD]
[TD="align: right"]Sun
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]7
[/TD]
[TD="align: right"]11/6/2017
[/TD]
[TD="align: right"]6
[/TD]
[TD="align: right"]Mon
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]8
[/TD]
[TD="align: right"]11/7/2017
[/TD]
[TD="align: right"]7
[/TD]
[TD="align: right"]Tue
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]9
[/TD]
[TD="align: right"]11/8/2017
[/TD]
[TD="align: right"]8
[/TD]
[TD="align: right"]Wed
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]10
[/TD]
[TD="align: right"]11/9/2017
[/TD]
[TD="align: right"]9
[/TD]
[TD="align: right"]Thu
[/TD]
[TD]A453
[/TD]
[/TR]
[TR]
[TD="align: center"]11
[/TD]
[TD="align: right"]11/10/2017
[/TD]
[TD="align: right"]10
[/TD]
[TD="align: right"]Fri
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]12
[/TD]
[TD="align: right"]11/11/2017
[/TD]
[TD="align: right"]11
[/TD]
[TD="align: right"]Sat
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]13
[/TD]
[TD="align: right"]11/12/2017
[/TD]
[TD="align: right"]12
[/TD]
[TD="align: right"]Sun
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]14
[/TD]
[TD="align: right"]11/13/2017
[/TD]
[TD="align: right"]13
[/TD]
[TD="align: right"]Mon
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]15
[/TD]
[TD="align: right"]11/14/2017
[/TD]
[TD="align: right"]14
[/TD]
[TD="align: right"]Tue
[/TD]
[TD]A650
[/TD]
[/TR]
[TR]
[TD="align: center"]16
[/TD]
[TD="align: right"]11/15/2017
[/TD]
[TD="align: right"]15
[/TD]
[TD="align: right"]Wed
[/TD]
[TD]A697
[/TD]
[/TR]
[TR]
[TD="align: center"]17
[/TD]
[TD="align: right"]11/16/2017
[/TD]
[TD="align: right"]16
[/TD]
[TD="align: right"]Thu
[/TD]
[TD]A1000
[/TD]
[/TR]
[TR]
[TD="align: center"]18
[/TD]
[TD="align: right"]11/17/2017
[/TD]
[TD="align: right"]17
[/TD]
[TD="align: right"]Fri
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]19
[/TD]
[TD="align: right"]11/18/2017
[/TD]
[TD="align: right"]18
[/TD]
[TD="align: right"]Sat
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]20
[/TD]
[TD="align: right"]11/19/2017
[/TD]
[TD="align: right"]19
[/TD]
[TD="align: right"]Sun
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]21
[/TD]
[TD="align: right"]11/20/2017
[/TD]
[TD="align: right"]20
[/TD]
[TD="align: right"]Mon
[/TD]
[TD]A433
[/TD]
[/TR]
[TR]
[TD="align: center"]22
[/TD]
[TD="align: right"]11/21/2017
[/TD]
[TD="align: right"]21
[/TD]
[TD="align: right"]Tue
[/TD]
[TD]A160, A214
[/TD]
[/TR]
[TR]
[TD="align: center"]23
[/TD]
[TD="align: right"]11/22/2017
[/TD]
[TD="align: right"]22
[/TD]
[TD="align: right"]Wed
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]24
[/TD]
[TD="align: right"]11/23/2017
[/TD]
[TD="align: right"]23
[/TD]
[TD="align: right"]Thu
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]25
[/TD]
[TD="align: right"]11/24/2017
[/TD]
[TD="align: right"]24
[/TD]
[TD="align: right"]Fri
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]26
[/TD]
[TD="align: right"]11/25/2017
[/TD]
[TD="align: right"]25
[/TD]
[TD="align: right"]Sat
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]27
[/TD]
[TD="align: right"]11/26/2017
[/TD]
[TD="align: right"]26
[/TD]
[TD="align: right"]Sun
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]28
[/TD]
[TD="align: right"]11/27/2017
[/TD]
[TD="align: right"]27
[/TD]
[TD="align: right"]Mon
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]29
[/TD]
[TD="align: right"]11/28/2017
[/TD]
[TD="align: right"]28
[/TD]
[TD="align: right"]Tue
[/TD]
[TD]A51
[/TD]
[/TR]
[TR]
[TD="align: center"]30
[/TD]
[TD="align: right"]11/29/2017
[/TD]
[TD="align: right"]29
[/TD]
[TD="align: right"]Wed
[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]31
[/TD]
[TD="align: right"]11/30/2017
[/TD]
[TD="align: right"]30
[/TD]
[TD="align: right"]Thu
[/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]

Nov17

I get the bolding and nothing deleted on Sheet1.

What line is highlighted if you debug?

this part deletes column D on the monthly but ignores Sheet1

Code:

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

Could you post a copy of the code you are running.

The complete code

Code:

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

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))

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

'jan
For y = 2 To lr
    keydate = ws.Cells(y, 4).Offset(, ws.Cells(y, 4))
    If keydate = "" Then
        MsgBox ("No date for the key meeting") ' comment out or remove if you do not want the message box
        GoTo invalidkeydate
        
    End If
    keyyear = Year(keydate)
    keymonth = Month(keydate)
    cusnumber = ws.Cells(y, 2)
    cuslen = Len(ws.Cells(y, 2))
    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
    
invalidkeydate:
Next y
End Sub

data manipulation

Manexcel

Board Regular

Manexcel

Board Regular

Excel Facts

Scott T

Well-known Member

Manexcel

Board Regular

Scott T

Well-known Member

Manexcel

Board Regular

Scott T

Well-known Member

Manexcel

Board Regular

Scott T

Well-known Member

Manexcel

Board Regular

Scott T

Well-known Member

Similar threads

Forum statistics

Share this page

data manipulation

Board Regular

Board Regular

Excel Facts

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock