Select case debug error

**Aussiebear** · 08-03-2016, 01:39 AM

I am currently looking for a method to automate data entry within a workbook in an effort to cut down on the workload required to present the data. Using columns G,H, I & J, in the following format.

	G	H	I	J
1	Port	Direction	Distance	Degrees
2	RBH	Automated value	63.5	28
3	RBH	Automated value	70.5.	34
4	RBH	Automated value	63.6	22

I would like cell H2 to read "NNE of RBH",cell H3 to read "NE of RBH" etc.
Here is my first attempt. (Poor as usual)

Private Sub DirOfMarkA()
Dim rCell As Range
Dim LRow As Long
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
With ActiveSheet
    For Each rCell In Range("H:" & LRow)
        If rCell.Offset(2, 0).Value <> "" Then
            Select Case rCell
            Case Is < 10  
            rCell = "N" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 33
            rCell = "NNE" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 55
            rCell = "NE" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 78
            rCell = "ENE' & "of" & rCell.Offset(-1, 0).Value
            Case Is < 100
            rCell = "E" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 123
            rCell = "ESE" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 145
            rCell = "SSE" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 168
            rCell = "S" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 190
            rCell = "SSW" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 213
            rCell = "SW" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 235
            rCell = "WSW" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 258
            rCell = "W" & "of" & Cell.Offset(-1, 0).Value
            Case Is < 280
            rCell = "WNW' & "of" & rCell.Offset(-1, 0).Value
            Case Is < 303
            rCell = "NW" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 325
            rCell = "NNW" & "of" & rCell.Offset(-1, 0).Value
            Case Is < 347
            rCell = "N" & "of" & rCell.Offset(-1, 0).Value
End Select
        End If
    Next rCell
End With
End Sub

Firstly this fails when debugging on the "End If" line, but then I'm not sure I'm on the right track here either. All suggestions welcome.

**GTO** · 08-03-2016, 03:48 AM

Hi Ted and long time since we've been able to "chat".

Firstly, at least as rendered in the web page, you have some typos. Cell instead of rCell, and some single quote marks where a double should be. Anyways, the first hiccup I spot is For Each rCell In Range("H:" & LRow). My guess would be that should be ...("H1:H" & lRow).Cells ?

Mark

**Paul_Hossler** · 08-03-2016, 06:40 AM

G'Day mate

Couple of typos and I think you wanted the .Offset parameters the other way around

Also, an alternative approach

Option Explicit

Private Sub DirOfMarkA()
    Dim rCell As Range, rLast As Range
    Dim LRow As Long
    'Activesheet and LRow - not needed
    LRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    
    'personal opinion - since J is the 'main' col being test, I just like to have it used
    Set rLast = ActiveSheet.Range("J2").End(xlDown)
    With ActiveSheet
        For Each rCell In Range("J2", rLast).Cells
            
            '.Offset uses (rows, columns) so (0,-2) not (2,0)
            If rCell.Offset(0, -2).Value <> "" Then
                Select Case rCell
                    Case Is < 10
                        'added space before and after "of" to spacing
                        rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 33
                        rCell.Offset(0, -2) = "NNE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 55
                        rCell.Offset(0, -2) = "NE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 78
                        'single quote "ENE'
                        rCell.Offset(0, -2) = "ENE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 100
                        rCell.Offset(0, -2) = "E" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 123
                        rCell.Offset(0, -2) = "ESE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 145
                        rCell.Offset(0, -2) = "SSE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 168
                        rCell.Offset(0, -2) = "S" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 190
                        rCell.Offset(0, -2) = "SSW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 213
                        rCell.Offset(0, -2) = "SW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 235
                        rCell.Offset(0, -2) = "WSW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 258
                        'rCell, not just Cell
                        rCell.Offset(0, -2) = "W" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 280
                        'single quote "WNW'
                        rCell.Offset(0, -2) = "WNW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 303
                        rCell.Offset(0, -2) = "NW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 325
                        rCell.Offset(0, -2) = "NNW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 347
                        rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
                End Select
            End If
        Next rCell
    End With
End Sub

Private Sub DirOfMarkA_1()
    Dim vHeading As Variant, vDirection As Variant
    Dim iMatch As Long
    Dim rRow As Range, rLast As Range
    
    
    vHeading = Array(10, 33, 55, 78, 100, 123, 145, 168, 190, 213, 235, 258, 280, 303, 325, 347)
    vDirection = Array("N", "NNE", "NE", "ENE", "E", "ESE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "N")
    
    Set rLast = ActiveSheet.Range("J2").End(xlDown)
    
    With ActiveSheet
        For Each rRow In Range("J2", rLast).EntireRow.Rows
            With rRow
                If .Cells(8).Value <> vbNullString Then
                    iMatch = Application.WorksheetFunction.Match(.Cells(10).Value, vHeading, 1)
                    .Cells(8).Value = vDirection(iMatch) & " of " & .Cells(7).Value
                End If
            End With
        Next
    End With
End Sub

**SamT** · 08-03-2016, 07:03 AM

Paul, you're missing the Point 'SE'

**Paul_Hossler** · 08-03-2016, 07:58 AM

Originally Posted by SamT

Paul, you're missing the Point 'SE'

No, Ted's missing it

Not being the salty nautical type, I just copied his from #1

**Aussiebear** · 08-03-2016, 02:24 PM

Yes is my bad. Too much rushing around trying to get organised for night shift. Will try these after a couple of hours sleep. Thanks for the inputs

**Aussiebear** · 08-03-2016, 11:33 PM

Here's what I have so far

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Dim rLast As Range
Dim LRow As Long
LRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "H").End(xlUp).Row
Set rLast = ActiveSheet.Range("J2").End(xlDown)
With ActiveSheet
    If Not Intersect(Target, Range("H2:H & Lrow")) Is Nothing Then
        For Each rCell In Range("J2", rLast).Cells
            If rCell.Offset(0, -2).Value <> "" Then
                Select Case rCell
                Case Is < 10
                    rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
                Case Is < 33
                    rCell.Offset(0, -2) = "NNE" & " of " & rCell.Offset(0, -3).Value
                Case Is < 55
                    rCell.Offset(0, -2) = "NE" & " of " & rCell.Offset(0, -3).Value
                Case Is < 78
                    rCell.Offset(0, -2) = "ENE" & " of " & rCell.Offset(0, -3).Value
                Case Is < 100
                    rCell.Offset(0, -2) = "E" & " of " & rCell.Offset(0, -3).Value
                Case Is < 123
                    rCell.Offset(0, -2) = "ESE" & " of " & rCell.Offset(0, -3).Value
                Case Is < 145
                    rCell.Offset(0, -2) = "SSE" & " of " & rCell.Offset(0, -3).Value
                Case Is < 168
                    rCell.Offset(0, -2) = "S" & " of " & rCell.Offset(0, -3).Value
                Case Is < 190
                    rCell.Offset(0, -2) = "SSW" & " of " & rCell.Offset(0, -3).Value
                Case Is < 213
                    rCell.Offset(0, -2) = "SW" & " of " & rCell.Offset(0, -3).Value
                Case Is < 235
                    rCell.Offset(0, -2) = "WSW" & " of " & rCell.Offset(0, -3).Value
                Case Is < 258
                    rCell.Offset(0, -2) = "W" & " of " & rCell.Offset(0, -3).Value
                Case Is < 280
                    rCell.Offset(0, -2) = "WNW" & " of " & rCell.Offset(0, -3).Value
                Case Is < 303
                    rCell.Offset(0, -2) = "NW" & " of " & rCell.Offset(0, -3).Value
                Case Is < 325
                    rCell.Offset(0, -2) = "NNW" & " of " & rCell.Offset(0, -3).Value
                Case Is < 347
                    rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
                End Select
            End If
        Next rCell
    End If
End With
End Sub

Still not triggering to fill cells H2 and down. Am I setting the trigger point (If J2 is empty then do nothing, otherwise calculate the Heading of the degrees value in Cell J2

Am I setting the trigger point (If J2 is empty then do nothing, otherwise in cell H2, calculate the Heading of the degrees value in Cell J2, and concatenate with "of" and the value in G2) correctly?

Initially Excel would not accept the name "DirOfMarkA", so changed that to "DOMA", then set the code as a Worksheet_Change event. Please that while the test file is only targetting "Mark A", I will then duplicate the same effect for "Mark B".

**GTO** · 08-04-2016, 03:58 AM

Originally Posted by Aussiebear

...Still not triggering to fill cells H2 and down. Am I setting the trigger point (If J2 is empty then do nothing, otherwise calculate the Heading of the degrees value in Cell J2

Am I setting the trigger point (If J2 is empty then do nothing, otherwise in cell H2, calculate the Heading of the degrees value in Cell J2, and concatenate with "of" and the value in G2) correctly?

Hi Ted,

I might not be of much help, but here is what I caught. At least as listed in the wb, that little degree symbol changes it to a string, so the numerical value is missed. I just tried Val() and it seems to work?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Dim rLast As Range
Dim LRow As Long


  LRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "H").End(xlUp).Row
  Set rLast = ActiveSheet.Range("J2").End(xlDown)
  
  With ActiveSheet
    If Not Intersect(Target, Range("H2:H" & LRow)) Is Nothing Then
      For Each rCell In Range("J2", rLast).Cells
        If rCell.Offset(0, -2).Value <> "" Then
          Application.EnableEvents = False
          Select Case Val(rCell.Value)
            Case Is < 10
            rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
            Case Is < 33
            rCell.Offset(0, -2) = "NNE" & " of " & rCell.Offset(0, -3).Value
            Case Is < 55
            rCell.Offset(0, -2) = "NE" & " of " & rCell.Offset(0, -3).Value
            Case Is < 78
            rCell.Offset(0, -2) = "ENE" & " of " & rCell.Offset(0, -3).Value
            Case Is < 100
            rCell.Offset(0, -2) = "E" & " of " & rCell.Offset(0, -3).Value
            Case Is < 123
            rCell.Offset(0, -2) = "ESE" & " of " & rCell.Offset(0, -3).Value
            Case Is < 145
            rCell.Offset(0, -2) = "SSE" & " of " & rCell.Offset(0, -3).Value
            Case Is < 168
            rCell.Offset(0, -2) = "S" & " of " & rCell.Offset(0, -3).Value
            Case Is < 190
            rCell.Offset(0, -2) = "SSW" & " of " & rCell.Offset(0, -3).Value
            Case Is < 213
            rCell.Offset(0, -2) = "SW" & " of " & rCell.Offset(0, -3).Value
            Case Is < 235
            rCell.Offset(0, -2) = "WSW" & " of " & rCell.Offset(0, -3).Value
            Case Is < 258
            rCell.Offset(0, -2) = "W" & " of " & rCell.Offset(0, -3).Value
            Case Is < 280
            rCell.Offset(0, -2) = "WNW" & " of " & rCell.Offset(0, -3).Value
            Case Is < 303
            rCell.Offset(0, -2) = "NW" & " of " & rCell.Offset(0, -3).Value
            Case Is < 325
            rCell.Offset(0, -2) = "NNW" & " of " & rCell.Offset(0, -3).Value
            Case Is < 347
            rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
          End Select
          Application.EnableEvents = True
        End If
      Next rCell
    End If
  End With
End Sub

Oh yeh, before I forget to mention... EnableEvents really needs to go to False in this case, as we are changing the same cell, so it starts a continuous loop

Well, I hope I helped a little bit at least.

Mark

**Paul_Hossler** · 08-04-2016, 06:49 AM

Assumes no empty cell in col J

This just looks for empty cells in Col H

rCell.Offset(0, -2).Value <> "" Then

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rCell As Range
    Dim rLast As Range
    
    
    With ActiveSheet
        Set rLast = .Range("J2").End(xlDown)
        
        If Intersect(Target, Range(Range("J2"), rLast)) Is Nothing Then Exit Sub
        
        Application.EnableEvents = False
        
        For Each rCell In Intersect(Target, Range(Range("J2"), rLast)).Cells
            If rCell.Offset(0, -2).Value <> "" Then
                Select Case rCell
                    Case Is < 10
                        rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 33
                        rCell.Offset(0, -2) = "NNE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 55
                        rCell.Offset(0, -2) = "NE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 78
                        rCell.Offset(0, -2) = "ENE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 100
                        rCell.Offset(0, -2) = "E" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 123
                        rCell.Offset(0, -2) = "ESE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 145
                        rCell.Offset(0, -2) = "SSE" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 168
                        rCell.Offset(0, -2) = "S" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 190
                        rCell.Offset(0, -2) = "SSW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 213
                        rCell.Offset(0, -2) = "SW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 235
                        rCell.Offset(0, -2) = "WSW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 258
                        rCell.Offset(0, -2) = "W" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 280
                        rCell.Offset(0, -2) = "WNW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 303
                        rCell.Offset(0, -2) = "NW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 325
                        rCell.Offset(0, -2) = "NNW" & " of " & rCell.Offset(0, -3).Value
                    Case Is < 347
                        rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
                End Select
            End If
        
        Next rCell
        
        
        Application.EnableEvents = True
    
    End With
End Sub

**snb** · 08-04-2016, 07:11 AM

Without redundant comments:

Sub M_snb()
 sn = Cells(1).CurrentRegion
 
 For j = 2 To UBound(sn)
   if sn(j,10)<>"" then sn(j, 8) = Choose(1 + sn(j, 10) \ 22.5, "N", "NNE", "NE", "ENE", "E", "ESE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "N") & " of " & sn(j, 7)
 Next
 
 Cells(1).CurrentRegion.Offset(10) = sn
End Sub

**SamT** · 08-04-2016, 11:18 AM

SE is also a compass point

**snb** · 08-05-2016, 07:14 AM

Also in the southern hemisphere ??

**Aussiebear** · 08-05-2016, 02:47 PM

@snb, Gives an error 13, highllights "sn(j, 8) = Choose(1 + sn(j, 10) \ 22.5, "N", "NNE", "NE", "ENE", "E", "ESE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "N") & " of " & sn(j, 7)"

@SamT, got it Sam .... three days ago.....

@Paul, thank you

**Aussiebear** · 08-05-2016, 11:19 PM

Still confused here. Nothing is happening to any of the blank cells in H2 and down to last cell.

Made some changes to test the logic of the values being tested namely;

Changed this line from

If rCell.Offset(0, -2).Value <> "" Then

to
[CODE]If rCell.Offset(0, -2).Value = "" Then/CODE]
Since if the cell is blank then calculate the value.

Also changed this line to see if it is failing to recognise the value in each cell in J2 and down.

Case Is < 10 & °

Still nothing happening.

As the code currently stands
[CODE]Private Sub Worksheet_Change(ByVal Target As Range) Dim rCell As Range
Dim rLast As Range
With ActiveSheet
Set rLast = .Range("J2").End(xlDown)
If Intersect(Target, Range(Range("J2"), rLast)) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rCell In Intersect(Target, Range(Range("J2"), rLast)).Cells
If rCell.Offset(0, -2).Value = "" Then
Select Case rCell
Case Is < 10 & °
rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
Case Is < 33 & °
rCell.Offset(0, -2) = "NNE" & " of " & rCell.Offset(0, -3).Value
Case Is < 55 & °
rCell.Offset(0, -2) = "NE" & " of " & rCell.Offset(0, -3).Value
Case Is < 78 & °
rCell.Offset(0, -2) = "ENE" & " of " & rCell.Offset(0, -3).Value
Case Is < 100 & °
rCell.Offset(0, -2) = "E" & " of " & rCell.Offset(0, -3).Value
Case Is < 123 & °
rCell.Offset(0, -2) = "ESE" & " of " & rCell.Offset(0, -3).Value
Case Is < 145 & °
rCell.Offset(0, -2) = "SE" & " of " & rCell.Offset(0, -3).Value
Case Is < 168 & °
rCell.Offset(0, -2) = "SSE" & " of " & rCell.Offset(0, -3).Value
Case Is < 190 & °
rCell.Offset(0, -2) = "S" & " of " & rCell.Offset(0, -3).Value
Case Is < 213 & °
rCell.Offset(0, -2) = "SSW" & " of " & rCell.Offset(0, -3).Value
Case Is < 235 & °
rCell.Offset(0, -2) = "SW" & " of " & rCell.Offset(0, -3).Value
Case Is < 258 & °
rCell.Offset(0, -2) = "WSW" & " of " & rCell.Offset(0, -3).Value
Case Is < 280 & °
rCell.Offset(0, -2) = "W" & " of " & rCell.Offset(0, -3).Value
Case Is < 303 & °
rCell.Offset(0, -2) = "WNW" & " of " & rCell.Offset(0, -3).Value
Case Is < 325 & °
rCell.Offset(0, -2) = "NW" & " of " & rCell.Offset(0, -3).Value
Case Is < 347 & °
rCell.Offset(0, -2) = "NNW" & " of " & rCell.Offset(0, -3).Value
Case Is >= 347 & °
rCell.Offset(0, -2) = "N" & " of " & rCell.Offset(0, -3).Value
End Select
End If
Next rCell
Application.EnableEvents = True
End With
End Sub
/CODE]

**snb** · 08-06-2016, 02:54 AM

Please, post an example file....

**Aussiebear** · 08-06-2016, 04:29 AM

You don't need another sample file. The file as posted in post # 7 is as good as it gets.

Your code fails with a type 13 error, which is highlighted with the following section:
"sn(j, 8) = Choose(1 + sn(j, 10) \ 22.5, "N", "NNE", "NE", "ENE", "E", "ESE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "N") & " of " & sn(j, 7)"

The logic of the issue is that as soon as I enter a bearing in J: Lrow it needs to;
1. Calculate the general heading. The general heading is defines by 22.5 degree increments starting with = or > 347° being "N".
2. Define a heading position of the value in H: LRow based on the value just entered in J:LRow.

Note that the bearing as indicated on J:LRow is defined as in degrees, and this will not change. This is as the client wants it to show.

**Paul_Hossler** · 08-06-2016, 06:49 AM

1. Not sure this is the way to go

Case Is < 10 & °

2. This will only give you the cell in J2:Jn that you changed

For Each rCell In Intersect(Target, Range(Range("J2"), rLast)).Cells

I think you want

For Each rCell In Range("J2"), rLast).Cells

3. I opted to use additional variables for (my) readability

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Dim rLast As Range
Dim Port As Range, Direction As Range
With ActiveSheet
    Set rLast = .Range("J2").End(xlDown)
    If Intersect(Target, Range(.Range("J2"), rLast)) Is Nothing Then Exit Sub ' added J2 dot
End With
Application.EnableEvents = False
For Each rCell In Range(Range("J2"), rLast).Cells
    With rCell
        
        Set Direction = .Offset(0, -2)  '   col H, 2 left from J
        Set Port = .Offset(0, -3)       '   col G, 3 left from J
        
        'port is 3 cols to the left, direction is 2
        If Len(Direction.Value) = 0 Then GoTo GetNext
        
        Select Case .Value
            Case Is < 10
                Direction.Value = "N" & " of " & Port.Value
            Case Is < 33
                Direction.Value = "NNE" & " of " & Port.Value
            Case Is < 55
                Direction.Value = "NE" & " of " & Port.Value
            Case Is < 78
                Direction.Value = "ENE" & " of " & Port.Value
            Case Is < 100
                Direction.Value = "E" & " of " & Port.Value
            Case Is < 123
                Direction.Value = "ESE" & " of " & Port.Value
            Case Is < 145
                Direction.Value = "SE" & " of " & Port.Value
            Case Is < 168
                Direction.Value = "SSE" & " of " & Port.Value
            Case Is < 190
                Direction.Value = "S" & " of " & Port.Value
            Case Is < 213
                Direction.Value = "SSW" & " of " & Port.Value
            Case Is < 235
                Direction.Value = "SW" & " of " & Port.Value
            Case Is < 258
                Direction.Value = "WSW" & " of " & Port.Value
            Case Is < 280
                Direction.Value = "W" & " of " & Port.Value
            Case Is < 303
                Direction.Value = "WNW" & " of " & Port.Value
            Case Is < 325
                Direction.Value = "NW" & " of " & Port.Value
            Case Is < 347
                Direction.Value = "NNW" & " of " & Port.Value
            Case Is >= 347
                Direction.Value = "N" & " of " & Port.Value
        End Select
    End With
GetNext:
Next rCell
    
Application.EnableEvents = True
End Sub

4. Another option might be a UDF

Option Explicit

' Each point is 360 / 16 / 2 degrees left and right (+/- 11.5 degrees)
' -10 = N and + 10 = N
Function DirOfMark(Port As String, Direction As Double) As String
    Dim vDirection As Variant
    Dim iCompass As Long
    
    vDirection = Array("N", "NNE", "NE", "ENE", "E", "ESE", "SE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "N")
    
    If Direction < 0# Then Direction = Direction + 360
    
    iCompass = ((Direction + 11.5) Mod 360) \ 22.5
    
    DirOfMark = vDirection(iCompass) & " of " & Port
End Function

5. Your line

If rCell.Offset(0, -2).Value = "" Then

says that if the Direction cell is empty, calculate the entry.

What happens I think is that if the macro puts in something or the user puts in something, then changing the degrees won't update it

I think you should delete the line, UNLESS you want to check for a non-blank Port

**snb** · 08-06-2016, 09:08 AM

50° <> 50

It would have been nice if you had adapted #1 to #7

**Aussiebear** · 08-06-2016, 01:21 PM

@snb There's no point in rolling all history (past posts) forward , since that would not show any progression within the thread.

**Aussiebear** · 08-06-2016, 01:24 PM

@Paul, Thank you. The code works very well.

Thread: Select case debug error

Thread Tools

Display

Select case debug error

Posting Permissions