VBA code tidy up

[JohnGow383]

Hi.
I'm new to VBA and my below code works but I'm sure there is a more efficient way of writing it and I'm keen to learn.
This code works and it basically copies a comment from a fixed merged cell in the first sheet (NOON Logs) to cells in another sheet (LOG Entries) in the same workbook. It's fired by a worksheet change in the first sheet. Each comment gets a prefixed consecutive number. The comments will populate a table of up to 8 cells in the 2nd sheet. So say there are two comments already, the code will see they are populated and copy and paste the comment into the 3rd cell and so on. When 8 are full a message box will appear to say maximum number of comments has been logged.
I have also started with it auto deleting the 2nd comment if the last 6 characters of the 2nd comment match the first and want to expand this. As you cn see the length of the code is getting longer and longer so I was wondering if there is a more elegant way of writing this? Here is the whole code from the Worksheet_change private sub. This calls the other copy child macros.

Dim DailyComment, ComRng1, ComRng2, ComRng3, ComRng4, ComRng5, ComRng6, ComRng7, ComRng8 As Range
    Dim Comment1, Comment2 As String
    
    Set ComRng1 = Sheets("LOG Entries").Range("T14")
    Set ComRng2 = Sheets("LOG Entries").Range("T15")
    Set ComRng3 = Sheets("LOG Entries").Range("T16")
    Set ComRng4 = Sheets("LOG Entries").Range("T18")
    Set ComRng5 = Sheets("LOG Entries").Range("T20")
    Set ComRng6 = Sheets("LOG Entries").Range("T22")
    Set ComRng7 = Sheets("LOG Entries").Range("T24")
    Set ComRng8 = Sheets("LOG Entries").Range("T26")
    Set DayCom = Range("H13")
    
    Comment1 = ComRng1.Value
    Comment2 = ComRng2.Value
       
    If Not Application.Intersect(Range("H13"), Target) Is Nothing Then 'Message box is trigger cell
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = False And IsEmpty(ComRng4) = False And IsEmpty(ComRng5) = False And IsEmpty(ComRng6) = False And IsEmpty(ComRng7) = False And IsEmpty(ComRng8) = False Then MsgBox "Maximum Number of Comments Logged", vbExclamation, Title:="Comment Logging"
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = False And IsEmpty(ComRng4) = False And IsEmpty(ComRng5) = False And IsEmpty(ComRng6) = False And IsEmpty(ComRng7) = False And IsEmpty(ComRng8) = True Then Call CopyDailyComment8
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = False And IsEmpty(ComRng4) = False And IsEmpty(ComRng5) = False And IsEmpty(ComRng6) = False And IsEmpty(ComRng7) = True Then Call CopyDailyComment7
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = False And IsEmpty(ComRng4) = False And IsEmpty(ComRng5) = False And IsEmpty(ComRng6) = True Then Call CopyDailyComment6
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = False And IsEmpty(ComRng4) = False And IsEmpty(ComRng5) = True Then Call CopyDailyComment5
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = False And IsEmpty(ComRng4) = True Then Call CopyDailyComment4
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = False And IsEmpty(ComRng3) = True Then Call CopyDailyComment3
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = False And IsEmpty(ComRng2) = True Then Call CopyDailyComment2
    If Len(DayCom) > 6 And IsEmpty(ComRng1) = True Then Call CopyDailyComment1
    
    If IsEmpty(ComRng1) = False And Right(Sheets("LOG Entries").Range("T14").Value, 6) = Right(Sheets("LOG Entries").Range("T15").Value, 6) Then Call ClearCom2 'If the same 2nd comment has been re-entered it will be deleted but leave the first.

Also, you can see I have made comments1 and 2 as string variables and assigned these to their respective ranges. The last line is used to check if comment 2 right 6 characters match comment 1 and then delete comment 2 if true. However I am having to use the whole range address to get this to work. When I use

If IsEmpty(ComRng1) = False And Right(Comment1, 6) = Right(Comment2, 6) Then Call ClearCom2

It doesn't seem to work.
As mentioned above, this all works and does what I need it to do, but I'd like to know if there is a better way of writing this.

Thanks

 

[dmt32]

As mentioned above, this all works and does what I need it to do, but I'd like to know if there is a better way of writing this.

Hi,
appreciate have a solution but another approach you could consider that may (or may not) achieve what you ask

Sub JohnGow()
    Dim ComRng      As Range, Cell As Range, DayCom As Range
    Dim Comment1    As Range, Comment2  As Range
    Dim i           As Long
  
    Set ComRng = ThisWorkbook.Worksheets("LOG Entries").Range("T14,T15,T16,T18,T20,T22,T24,T26")
  
    Set Comment1 = ComRng.Cells(1, 1)
    Set Comment2 = ComRng.Cells(2, 1)
 
    'Message box is trigger cell
    If Not Application.Intersect(Range("H13"), Target) Is Nothing Then
      
        Set DayCom = Target
      
        If Len(DayCom.Value) > 6 Then
          
            For Each Cell In ComRng.Cells
                If IsEmpty(Cell.Value) Then Exit For Else i = i + 1
            Next Cell
          
            Select Case i
                Case Is >= 8
                    MsgBox "Maximum Number of Comments Logged", vbExclamation, "Comment Logging"
                Case Else
                    Application.Run "CopyDailyComment" & i + 1
            End Select
          
        End If
      
        'If the same 2nd comment has been re-entered it will be deleted but leave the first.
        If i > 0 And Right(Comment1.Value, 6) = Right(Comment2.Value, 6) Then Call ClearCom2
    End If
End Sub

You mention that your string Variables Comment1 & Comment2 do not work as expected so I have changed then to Range Object Variables - see if this makes any difference.

I have only had quick glance at your code & suggestion not tested but may give you some further ideas

Dave

 

[6StringJazzer]

I have a good few other Worksheet_change in the same sheet

You can only have one Sub Worksheet_Change in a given sheet.

 

[JohnGow383]

Hi,
appreciate have a solution but another approach you could consider that may (or may not) achieve what you ask

Sub JohnGow()
    Dim ComRng      As Range, Cell As Range, DayCom As Range
    Dim Comment1    As Range, Comment2  As Range
    Dim i           As Long
 
    Set ComRng = ThisWorkbook.Worksheets("LOG Entries").Range("T14,T15,T16,T18,T20,T22,T24,T26")
 
    Set Comment1 = ComRng.Cells(1, 1)
    Set Comment2 = ComRng.Cells(2, 1)
 
    'Message box is trigger cell
    If Not Application.Intersect(Range("H13"), Target) Is Nothing Then
    
        Set DayCom = Target
    
        If Len(DayCom.Value) > 6 Then
        
            For Each Cell In ComRng.Cells
                If IsEmpty(Cell.Value) Then Exit For Else i = i + 1
            Next Cell
        
            Select Case i
                Case Is >= 8
                    MsgBox "Maximum Number of Comments Logged", vbExclamation, "Comment Logging"
                Case Else
                    Application.Run "CopyDailyComment" & i + 1
            End Select
        
        End If
    
        'If the same 2nd comment has been re-entered it will be deleted but leave the first.
        If i > 0 And Right(Comment1.Value, 6) = Right(Comment2.Value, 6) Then Call ClearCom2
    End If
End Sub

You mention that your string Variables Comment1 & Comment2 do not work as expected so I have changed then to Range Object Variables - see if this makes any difference.

I have only had quick glance at your code & suggestion not tested but may give you some further ideas

Dave

Thanks Dave, much appreciate the time you've taken to have a look at this. I will try it out later once I'm near the computer again.
The only thing I can see looking at the code is that it's calling a generic copy comment if 8 or more aren't populated. Each of my copy comment child macros contain a text string which adds a consecutive number as well as application.speech but I think I could modify the above for each case to call correct comment macro.

 

[JohnGow383]

You can only have one Sub Worksheet_Change in a given sheet.

Sorry I meant I've multiple different triggers for other things within the same worksheet_change sub.

 

[dmt32]

Thanks Dave, much appreciate the time you've taken to have a look at this. I will try it out later once I'm near the computer again.
The only thing I can see looking at the code is that it's calling a generic copy comment if 8 or more aren't populated.

Hi,
As said, I only had a quick glance at your post & suggestion was to give another approach you can consider for your project & you should adjust as required to meet specific project need.

Hope find helpful

Dave

 

[JohnGow383]

Hi,
As said, I only had a quick glance at your post & suggestion was to give another approach you can consider for your project & you should adjust as required to meet specific project need.

Hope find helpful

Dave

The fact you've merely had a quick glance and come up with that is pretty awesome in itself. Awe inspiring. I am going to try it and type it out again just to give me more practice and hopefully try to understand it all better. Thanks again

 

[JohnGow383]

Hi,
As said, I only had a quick glance at your post & suggestion was to give another approach you can consider for your project & you should adjust as required to meet specific project need.

Hope find helpful

Dave

Hi, just to let you know the code worked perfectly. Thanks so much.
I had to make a couple of adjustments but all the delete macros work as they should so setting those variables as a range rather than a string works.
Also, because I have multiple triggers for different things in that sheet, setting DayCom As Target broke the other worksheet changes. So I changed this to the actual range and now everything is working.
Here is my slightly modified code:

'This code copies any comments from the message box in NOON Figs into LOG Entries. When comments autodelete from the message box they aren't lost.
    'Up to 8 different comments will populate. They're deleted after Carry Forward / New Voyage is called. The message box is the trigger cell if string is longer than 6 characters.
    'If the same comment has been entered consecutively then it is autodeleted and the user is notified
    
    Dim ComRng      As Range, Cell As Range, DayCom As Range
    Dim Comment1    As Range, Comment2  As Range, Comment3 As Range, Comment4 As Range
    Dim Comment5    As Range, Comment6  As Range, Comment7 As Range, Comment8 As Range
    Dim i           As Long
  
    Set ComRng = Sheets("LOG Entries").Range("T14,T15,T16,T18,T20,T22,T24,T26")
  
    Set Comment1 = ComRng.Cells(1, 1)
    Set Comment2 = ComRng.Cells(2, 1)
    Set Comment3 = ComRng.Cells(3, 1)
    Set Comment4 = ComRng.Cells(5, 1)
    Set Comment5 = ComRng.Cells(7, 1)
    Set Comment6 = ComRng.Cells(9, 1)
    Set Comment7 = ComRng.Cells(11, 1)
    Set Comment8 = ComRng.Cells(13, 1)
 
    'Message box in NOON Figs is the trigger cell
    If Not Application.Intersect(Range("H13"), Target) Is Nothing Then
      
        Set DayCom = Range("H13")
      
        If Len(DayCom.Value) > 6 Then 'Only triggers when H13 message box in NOON Logs has more than 6 characters
          
            For Each Cell In ComRng.Cells 'Creates a loop
                If IsEmpty(Cell.Value) Then Exit For Else i = i + 1
            Next Cell
          
            Select Case i
                Case Is >= 8
                    MsgBox "Maximum Number of Comments Logged", vbExclamation, "Comment Logging"
                Case Is = 7
                    Call CopyDailyComment8
                Case Is = 6
                    Call CopyDailyComment7
                Case Is = 5
                    Call CopyDailyComment6
                Case Is = 4
                    Call CopyDailyComment5
                Case Is = 3
                    Call CopyDailyComment4
                Case Is = 2
                    Call CopyDailyComment3
                Case Is = 1
                    Call CopyDailyComment2
                Case Is = 0
                    Call CopyDailyComment1
                Case Else
            End Select
          
        End If
      
        'If the same comment has been re-entered it will be deleted but leave the one before.
        If i > 0 And Right(Comment1.Value, 6) = Right(Comment2.Value, 6) Then Call ClearCom2
        If i > 0 And Len(Comment3.Value) > 6 And Right(Comment2.Value, 6) = Right(Comment3.Value, 6) Then Call ClearCom3
        If i > 0 And Len(Comment4.Value) > 6 And Right(Comment3.Value, 6) = Right(Comment4.Value, 6) Then Call ClearCom4
        If i > 0 And Len(Comment5.Value) > 6 And Right(Comment4.Value, 6) = Right(Comment5.Value, 6) Then Call ClearCom5
        If i > 0 And Len(Comment6.Value) > 6 And Right(Comment5.Value, 6) = Right(Comment6.Value, 6) Then Call ClearCom6
        If i > 0 And Len(Comment7.Value) > 6 And Right(Comment6.Value, 6) = Right(Comment7.Value, 6) Then Call ClearCom7
        If i > 0 And Len(Comment8.Value) > 6 And Right(Comment7.Value, 6) = Right(Comment8.Value, 6) Then Call ClearCom8
    End If

When you set the comment ranges using

.Cells

is there any particular advantage doing that as oppose to using the other method? Some of the comment cells are merged but it still works perfectly.
Thanks for your assitance as well as 6StringJazzer. The more options and different methods the better. Having different examples of doing things really helps when building future projects.
For what started out as a hand written log has expanded to a pretty advanced spreadsheet which contains 600 formulas and 128 macros

Thanks everyone

 

[dmt32]

Hi,
glad you have your project working & that we were able to assist.

Just curious

did this approach in my code not work for you?

Select Case i
                Case Is >= 8
                    MsgBox "Maximum Number of Comments Logged", vbExclamation, "Comment Logging"
                Case Else
                    Application.Run "CopyDailyComment" & i + 1
            End Select

Whole point of a counter ( i ) in the For Next Loop was to be able use Run method to call the correct procedure negating the need for all those case statements.

Also, you have changed this line

Set ComRng = ThisWorkbook.Worksheets("LOG Entries").Range("T14,T15,T16,T18,T20,T22,T24,T26")

to this

Set ComRng = Sheets("LOG Entries").Range("T14,T15,T16,T18,T20,T22,T24,T26")

Beware that the Sheets collection can contain Chart or Worksheet objects - as you are working with a Worksheet it is appropriate to specify this also, I qualified the the worksheet with the ThisWorkbook as this represents the workbook where the macro code is running.

Dave

 

[JohnGow383]

Hi Dave,
You're quite right on both accounts. I'm not sure why I just used sheets. Is using Workbook.worksheets good practice going forward for other references?
Also, I must have not typed the code correctly at the time as I've just tried it again with the case else i +1 and application.run and it works perfectly. I'm still not 100% sure how it knows which macro to call with just using the counter but what an elegant solution. Thanks

 

[dmt32]

Hi Dave,
You're quite right on both accounts. I'm not sure why I just used sheets. Is using Workbook.worksheets good practice going forward for other references?

Most certainly because If you do not specify the workbook then the active workbook is used by default - not a problem if you only ever have one workbook open but that's not very likely so much safer to qualify to correct workbook.

Glad all resolved - good luck with your project

Dave