Macro execution gets interrupted in the last iteration while performing multiple find and replace

[fblaze88]

Below code searches for the pattern “SESSION DESCRIPTION =”<null>” IS” and if such a pattern is found, asks for Input from the user and replaces the NULL with user's input (Example: SESSION DESCRIPTION =”This input was given by user”).

This code searches the source sheet in its entirety and corrects all NULL description.

Only problem that I face here is, whenever the code reaches the last matching pattern, it stops with a message ”Code execution has been interrupted”.

Sub Missing_Description()
'
'
'
 
Dim ws As Worksheet
Dim Get_Sess_Nm1 As Integer
Dim Get_Sess_Nm2 As Integer
Dim Get_blnk_desc1 As Integer
 
Set ws = Sheet1
With ws.UsedRange
 
Set range1 = .Find(What:="SESSION DESCRIPTION ="""" IS", After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
    
     
    If Not range1 Is Nothing Then
        firstAddress = range1.Address
              
    Do
        range1.Activate
        Get_Sess_Nm1 = InStr(1, range1.Value, " NAME =")
        Get_Sess_Nm2 = InStr(1, range1.Value, " REUSABLE")
        Session_Name = Replace(Trim(Mid(range1.Value, Get_Sess_Nm1 + 8, Get_Sess_Nm2 - (Get_Sess_Nm1 + 8))), Chr(34), "")
        Get_Session_Desc = InputBox("Description not present for session:" & Session_Name, "Please provide session description")
        
        Get_blnk_desc1 = InStr(1, range1.Value, "SESSION DESCRIPTION =" & Chr(34))
        Get_blnk_desc2 = InStr(Get_blnk_desc1, range1.Value, Chr(34) & " ISVALID")
        Session_Desc = Mid(range1.Value, 1, Get_blnk_desc1 - 1) & Mid(range1.Value, Get_blnk_desc1, 22) & Get_Session_Desc & Mid(range1.Value, Get_blnk_desc2)
        range1.Value = Session_Desc
        Set range1 = .FindNext(range1)
       
    Loop While Not range1 Is Nothing And range1.Address <> firstAddress
       
    End If
 
End With
End Sub

Please let me know, how I can avoid this error or any work around is required for it..</null>

 

[hiker95]

fblaze88,

Welcome to the MrExcel forum.

What version of Excel and Windows are you using?

So that we can get it right the first time, can we see your workbook?

You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.


If you are not able to provide your workbook, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[fblaze88]

@[hiker95]
Thanks for your reply!

I'm using MS-EXCEL 2007 in windows 7. I have uploaded a sample extract of my file in Box Net. Please check the below link:

https://app.box.com/s/3foo494y6c0jq6kunbfb

 

[fblaze88]

Bump!

 

[hiker95]

fblaze88,

Thanks for the workbook.

With ws.UsedRange

One of the reasons your macro did not run correctly, or, did not process all the rows, is because there were blank rows between the sections of raw data, so the ws.UsedRange only picked up the first 30 rows.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub Missing_DescriptionV2()
' hiker95, 12/31/2013
' http://www.mrexcel.com/forum/excel-questions/747616-macro-execution-gets-interrupted-last-iteration-while-performing-multiple-find-replace.html
 
Dim ws As Worksheet
Dim Get_Sess_Nm1 As Integer
Dim Get_Sess_Nm2 As Integer
Dim Get_blnk_desc1 As Integer
Dim lr As Long, c As Range

Set ws = Sheet1

With ws
  On Error Resume Next
  .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End With

With ws.UsedRange
  Set range1 = .Find(What:="SESSION DESCRIPTION ="""" IS", After:=ActiveCell, LookIn:= _
    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False, SearchFormat:=False)
  
  If Not range1 Is Nothing Then
    firstAddress = range1.Address
     
    Do
      range1.Activate
      Get_Sess_Nm1 = InStr(1, range1.Value, " NAME =")
      Get_Sess_Nm2 = InStr(1, range1.Value, " REUSABLE")
      Session_Name = Replace(Trim(Mid(range1.Value, Get_Sess_Nm1 + 8, Get_Sess_Nm2 - (Get_Sess_Nm1 + 8))), Chr(34), "")
      Get_Session_Desc = InputBox("Description not present for session:" & Session_Name, "Please provide session description")
      
      Get_blnk_desc1 = InStr(1, range1.Value, "SESSION DESCRIPTION =" & Chr(34))
      Get_blnk_desc2 = InStr(Get_blnk_desc1, range1.Value, Chr(34) & " ISVALID")
      Session_Desc = Mid(range1.Value, 1, Get_blnk_desc1 - 1) & Mid(range1.Value, Get_blnk_desc1, 22) & Get_Session_Desc & Mid(range1.Value, Get_blnk_desc2)
      range1.Value = Session_Desc
      Set range1 = .FindNext(range1)
    Loop While Not range1 Is Nothing And range1.Address <> firstAddress
  End If
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Missing_DescriptionV2 macro.