Wrong Value In Trying To Determine Last Occupied Cell in A Column

[Ark68]

I have this code that is intended to either insert, or delete, a range of cells depending on a default minimum and maximum number of rows in the "pda services" range. The "pda services" range is dynamic, and starts at the first row after the value "ADD" in column A of the worksheet (in my testing is currently row 22). The last row should always be 31 or greater if all rows up to and 31 are including. Once the range at row 31 is filled, the "pda services" range can continue to expand. The "pda_services" range cannot ever be less than 31.

I use the procedure 'rng_pdasvc' to determine the current "pda services range". I set that range to a variable "rng_pdaservices". It encompasses all the cells between columns A and R of the upper and lower rows identified in this procedure.

Sub rng_pdasvc()
  
  
    With ws_master
        'define pda service range
        rng_svctop = Application.Match("ADD", .Columns(1), 0) + 1 'row 22 in my testing
        If IsError(rng_svctop) = True Then MsgBox CLng(Split(CStr(rng_svctop), " ")(1))
          
        rng_svcbot = Application.Match("Facility Maintenance Activities", .Columns(1), 0) - 3
        If IsError(rng_svcbot) = True Then MsgBox CLng(Split(CStr(rng_svcbot), " ")(1))
      
        Set rng_pdaservices = .Range("A" & rng_svctop & ":Q" & rng_svcbot)
      
        dr_pdasvc = Range("A" & rng_svcbot).End(xlUp).Row + 1
    End With
      
End Sub

I then have code which finds the last row in range "rng_pdaservices". Despite "rng_pdaservices" being properly set, the value for strow is always 22, even if A23:A25 are occupied with values. I would expect a value of 26 in this case, but I only get 22.

Sub trn_srv_svcrng()
 'determine pda service range
 'eliminate current RID entries in pda service range (rewritten in full)
 'export services from thold to pda service range (last row of data)
 'sort new pda range (inclusive of previous non rid rentals)
 'add rows to default pda size (21 rows between 12 and 32, shared rows 36/37 with staff - EVL1 & EVL2)
 'Stop
 Dim DelRng As Range
 Application.ScreenUpdating = False
   
    'define current pda services range
    rng_pdasvc
'Stop
    With ws_master
        .Unprotect
        mbevents = False
       
        'eliminate crid entries from rng_pdaservices
        .Activate
        For Each cell In rng_pdaservices.Columns(1).Rows
            Debug.Print "Cell Value" & cell.Value & "  cell: " & cell.Address
            If cell.Value = crid Then
                If DelRng Is Nothing Then Set DelRng = cell Else Set DelRng = Union(DelRng, cell)
            End If
        Next cell
        If Not DelRng Is Nothing Then Intersect(DelRng.EntireRow, rng_pdaservices).Delete
       
        'rng_pdasvc
        'strow = Application.WorksheetFunction.Match("ADD", .Columns(1), 0) + 1
        'On Error Resume Next
        'strow = rng_pdaservices.Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Address(0, 0) + 1
        'On Error GoTo 0
        'ui1 = MsgBox("Insert row at: " & strow, vbQuestion + vbYesNo, "PDA Services")
        'If ui1 = vbYes Then
        '    .Range("A" & strow & ":R" & strow).Insert Shift:=xlDown
        'End If
        'svclr = Application.WorksheetFunction.Match("Facility Maintenance Activities", Columns(1), 0)
        'If svclr < 34 Then
        '    .Range("A31:R31").Insert Shift:=xlDown
        'End If
'Stop
        'add service to pda services range
        'determine destination row
        drow = Application.WorksheetFunction.Match("ADD", .Columns(1), 0) + 1
        On Error Resume Next
        drow = rng_pdaservices.Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Address(0, 0) + 1
        On Error GoTo 0
        'MsgBox drow
   
        srvcs_no = Application.WorksheetFunction.CountA(ws_thold.Range("AK1:AK8"))
        scol = 13 'destination ws_master column M (row = srow)
        srccol = 1 'source row ws_thold column AI
       
       
        For L1 = 1 To srvcs_no
            If drow > 32 Then 'add row
                drow = drow + 1
                MsgBox "Not enough room. Row added at " & drow + 1, , "UNTESTED"
                Stop
                .Range("A" & drow & ":R" & drow).Insert Shift:=xlDown
            End If
            With .Range("H" & drow & ":Q" & drow)
                .Cells.Value = ""
                .Cells.Interior.Color = RGB(166, 166, 166)
                .Cells.locked = True
            End With
            If L1 = 5 Then
                scol = scol - 4
            End If
            Set rng_cpy = ws_master.Range("A" & srow & ":G" & srow)
            rng_cpy.Copy ws_master.Range("A" & drow)
            With .Cells(drow, scol)
                .Value = ws_thold.Cells(srccol, 39)
                .Interior.ColorIndex = 0
            End With
            If ws_thold.Cells(srccol, 36) = "RLN" Then
                d1 = "Reline"
            Else
                d1 = "Change"
            End If
            dmsg = d1 & " " & ws_thold.Cells(srccol, 37) & "-" & ws_thold.Cells(srccol, 38)
            With .Cells(drow, 2)
                .Font.Size = 6
                .Font.Color = vbBlack
                .Font.Bold = True
                .Value = dmsg
                .HorizontalAlignment = xlCenter
            End With
            With .Cells(drow, 8) '.Cells(drow, 18)
                .Value = ws_thold.Cells(srccol, 43)
                .Font.Size = 6
                .Font.Color = vbBlue 'RGB(229, 242, 251)
            End With

            .Rows(drow).AutoFit
            .Rows(drow).Cells.locked = True
            .Range(.Cells(drow, 1), .Cells(drow, 17)).VerticalAlignment = xlCenter
            scol = scol + 1
            srccol = srccol + 1
            drow = drow + 1
        Next L1
        Stop
        rng_pdasvc
        strow = Application.WorksheetFunction.Match("ADD", .Columns(1), 0) + 1
        On Error Resume Next
        strow = rng_pdaservices.Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Address(0, 0) + 1
        On Error GoTo 0
        
        mtrow = Application.WorksheetFunction.Match("Facility Maintenance Activities", .Columns(1), 0) - 3
        If mtrow > 31 And .Range("A31") <> "" Then
            ui1 = MsgBox("Delete row at: " & strow, vbQuestion + vbYesNo, "PDA Services")
            If ui1 = vbYes Then
                .Range("A" & strow & ":R" & strow).Delete Shift:=xlUp
            End If
        End If
        If mtrow < 31 Then
            ui1 = MsgBox("Add row at: " & strow, vbQuestion + vbYesNo, "PDA Services")
            If ui1 = vbYes Then
                .Range("A" & strow & ":R" & strow).Insert Shift:=xlDown
            End If
        End If
       
'Stop
        pda_sort rng_pdaservices
        .Protect
        mbevents = True
    End With
    Application.ScreenUpdating = True
'Stop 'try save      SAVE FAILS
End Sub

Any ideas.

 

[Ark68]

Hi Alex, once again I extend my thanks for your efforts to help me resolve this.

I have adjusted my code to reflect your suggestion, but I'm getting an "Ambiguous name detected: rng_pdasvc" with this line in my new code:

Sub trn_srv_svcrng()

   Dim DelRng As Range 'range of and deleted ranges from within PDA Service range
   Application.ScreenUpdating = False
   
    Set rng_pdaservices = rng_pdasvc
    If rng_pdaservices Is Nothing Then Exit Sub
    'rng_pdasvc   

    With ws_master 'the worksheet in my post
        .Unprotect
        mbevents = False 'don't trigger any worksheet change events
        ...

I made this change twice in my trn_srv_svcrng procedure.This was the first of the two. I have included the function in another module, and removed my public declaration of "rng_pdaservices". There are no other declarations of "rng_pdaservices" or rng_pdasvc in my project.

 

[Alex Blakenburg]

When you say that you "have included the function in another module" do you mean you have 2 functions with the same name in this workbook ?
If so then that will be why the name is ambiguous.

Functions & Subs are Public unless they have the word Private added to the front (ie Private Function rng_pdasvc).
The Private would restrict its use to just that module. You would want to do it to both occurrences though.
Not sure I would have 2 Functions or Subs with the same name in the same workbook but as long as you add Private it should be work.

 

[Ark68]

Hey Alex, thank you for providing the solution I needed. It works wonderfully and now allows me to move forward with my project.

When you say that you "have included the function in another module" do you mean you have 2 functions with the same name in this workbook ?
If so then that will be why the name is ambiguous.

Yes and no ... I put the function you provided in a module I have set aside for just functions. What I failed to do was get rid of the original sub.

 

[Alex Blakenburg]

Glad to hear it. Happy I could help.