Loop or For/Next using an InputBox response

Js Smith

New Member
Joined
Jul 24, 2020
Messages
44
Office Version
  1. 2010
Platform
  1. Windows
Hi all! I've got code to do tedious data entry at work. The company doesn't want to change how they do it so I have a spreadsheet that will open and update a specified Excel file on a network drive.
I'd like it to work for all the rows with the same submittal# i.e. if there's 5 rows with submittal # 1.1 then the code would run through all of then before running the Calls, but stumped on how. Was thinking of a loop or a For/Next but having difficulty on how to stitch that into this:

VBA Code:
Sub AddResubmittalRow()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
    End If

Dim found As Range
Set found = Sheets("OFFICE").Columns("E").Find(what:=InputBox("Enter the Submittal # to find", "Submittal #"), LookIn:=xlValues, lookAt:=xlWhole)


If found Is Nothing Then
    MsgBox "Not found"
Else
        found.Select
End If

  ActiveCell.Offset(1, 0).EntireRow.Insert
  Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Copy
  ActiveCell.Offset(1, -4).PasteSpecial xlPasteValues
  ActiveCell.Offset(, 3).Resize(, 1).Value = Date
  ActiveCell.Offset(, 10).Resize(, 1).Value = Date
  ActiveCell.Offset(, 1).Resize(, 1).Value = ActiveCell.Offset(, 1).Resize(, 1).Value & " RESUBMITTAL"
  ActiveCell.Offset(, 4).Resize(, 1).Value = ActiveCell.Offset(, 4).Resize(, 1).Value & "R"
      Application.CutCopyMode = False
      Application.CutCopyMode = True

Call font

Question:
 GoAgain = MsgBox("Add another?", vbYesNo, "Continue?")

If GoAgain = vbYes Then
Call InsertRowAgain
GoTo Question

 End If

 End Sub

Sub InsertRowAgain()
 Dim found As Range
Set found = Sheets("OFFICE").Columns("E").Find(what:=InputBox("Enter the Submittal # to find", "Submittal #"), LookIn:=xlValues, lookAt:=xlWhole)
If found Is Nothing Then
    MsgBox "Not found"
Else
        found.Select
End If

  ActiveCell.Offset(1, 0).EntireRow.Insert
  Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Copy
  ActiveCell.Offset(1, -4).PasteSpecial xlPasteValues
  ActiveCell.Offset(, 3).Resize(, 1).Value = Date
 ActiveCell.Offset(, 10).Resize(, 1).Value = Date
  ActiveCell.Offset(, 1).Resize(, 1).Value = ActiveCell.Offset(, 1).Resize(, 1).Value & " RESUBMITTAL"
  ActiveCell.Offset(, 4).Resize(, 1).Value = ActiveCell.Offset(, 4).Resize(, 1).Value & "R"
      Application.CutCopyMode = False
     Application.CutCopyMode = True

Call font
 
End Sub


Sub font()
'
' font Macro
'

'
   Dim c As Range
    Dim strFind As String
    Dim firstAddress As String
    strFind = "RESUBMITTAL"

    With Cells

     Set c = .Find(strFind, LookIn:=xlValues, lookAt:=xlPart)

        If Not c Is Nothing Then
            firstAddress = c.Address
            c.Characters(Start:=InStr(1, c.Value, strFind), Length:=Len(strFind)).font.ColorIndex = 3
        Else:
            MsgBox "Not Found"
            End
        End If

        Set c = .FindNext(c)

        If Not c Is Nothing And c.Address <> firstAddress Then
            Do
               c.Characters(Start:=InStr(1, c.Value, strFind), Length:=Len(strFind)).font.ColorIndex = 3
                Set c = .FindNext(c)

            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

I've had to kill Excel from the Task Manager more than once due to a errant never ending loop. :oops:
Thanks, as always, for your guidance!
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Some tips ...

Use of End ... usually frowned upon... Terminates execution immediately, closes files opened with the 'Open' statement & clears variables "
One googled page mentioned "Using End is a lot like pulling a hand brake in a car. It stops the car, but often so abruptly it might cause it to crash"

When you do 'Else:' ... just use Else

Whenever you do the following 2 lines ... it accomplish nothing ... You turn it off and then back on again
Application.CutCopyMode = False
Application.CutCopyMode = True
 
Upvote 0
@johnnyL thanks for your input but it doesn't answer my issue with the loop or For/Next usage.

I used the Application.CutCopyMode = False to stop the 'marching ants'. Application.CutCopyMode = True functionally does nothing but it's a habit due to my constantly forgetting the true for other operations. Now, if I throw a false in, the true goes in too. No harm, no foul there; maybe a little code bloat.
I'll read up on End, to see if I agree with your assessment. In the instance of the Font sub, that was an error committed when someone came into my office on full tilt. It was meant to be the End If
 
Upvote 0
Glad to hear you figured out a solution.

Please post about your solution. Then it is perfectly fine to mark your post as the solution to help future readers.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top