Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,564
- Office Version
- 365
- 2016
- Platform
- Windows
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.
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.
Any ideas.
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.
Code:
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 SubI 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.
Rich (BB code):
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 SubAny ideas.
Last edited:
