Solved

How to modify my VBA code that can only target 1 row at a time to keep running for each additional row that is not empty?

Posted on 2016-09-08
9
23 Views
Last Modified: 2016-09-28
I have an Access table that I need to update.  The author of the DB created a sub that I can call with the info that needs to be added.  The code works, but I can only do one record at a time.   I’m trying to figure out how to run the code for row 2, and then if cell A3 is not blank run the code for row 3 and so on until it gets to a row where the cell in column A is blank.
Sub modIncTool()
On Error Resume Next
Dim objAcc As Object
theOriginalQuote = Sheets("Import").Range("A2")
theNewQuote = Sheets("Import").Range("B2")
theSiteGroup = Sheets("Import").Range("F2")
theTechnician = Sheets("Import").Range("G2")
theReason = Sheets("Import").Range("H2")
theDateRequested = Sheets("Import").Range("I2")
Set objAcc = GetObject(, "Access.Application")
Result = objAcc.run("RecreateTool_AddRecord", theOriginalQuote, theNewQuote, theSiteGroup, theTechnician, theReason, theDateRequested)
Set objAcc = Nothing
End Sub

Open in new window

0
Comment
Question by:kbay808
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
9 Comments
 
LVL 20
ID: 41790496
Sub modIncTool()
'160908 modified s4p
   On Error Resume Next
   
   Dim nRow As Long _
      , theOriginalQuote _
      , theNewQuote _
      , theSiteGroup _
      , theTechnician _
      , theReason _
      , theDateRequested _
      , Result
      
   Dim objAcc As Object
   Set objAcc = GetObject(, "Access.Application")
   
   nRow = 2
   
   With Sheets("Import")
      Do While .Cells(nRow, 1) <> ""
         theOriginalQuote = .Range(.Cells(nRow, 1))
         theNewQuote = .Range(.Cells(nRow, 2))
         theSiteGroup = .Range(.Cells(nRow, 6))
         theTechnician = .Range(.Cells(nRow, 7))
         theReason = .Range(.Cells(nRow, 8))
         theDateRequested = .Range(.Cells(nRow, 9))
         Result = objAcc.Run( _
            "RecreateTool_AddRecord" _
            , theOriginalQuote _
            , theNewQuote _
            , theSiteGroup _
            , theTechnician _
            , theReason _
            , theDateRequested _
            )
         nRow = nRow + 1
      Loop
   End With
   Set objAcc = Nothing
   
   MsgBox "Did up to row " & nRow - 1, , "Done"
   
End Sub

Open in new window


what do you plan to do with the Result ? It is calculated but goes nowhere ...
0
 

Author Comment

by:kbay808
ID: 41791398
The result needs to look like this.
Result = objAcc.run("RecreateTool_AddRecord", theOriginalQuote, theNewQuote, theSiteGroup, theTechnician, theReason, theDateRequested)

Open in new window

The result is calling for the below sub to run in the Access DB.
Public Sub RecreateTool_AddRecord( _
                ByVal theOriginalQuote As String, _
                ByVal theNewQuote As String, _
                ByVal theSiteGroup As Long, _
                ByVal theTechnician As String, _
                ByVal theReason As String, _
                ByVal theDateRequested As String)

    sSQL = "INSERT INTO [Quote Recreation Tracker] ([Original Quote#], [New Quote#], [Status], " & _
        "[Requesting Technician Site Group], [Requesting Technician User Name], [Reason for Request], " & _
        "[Date Requested], [Date Completed]) " & "VALUES ( '" & _
        theOriginalQuote & "', '" & theNewQuote & "', 'Approved', " & theSiteGroup & ", '" & _
        theTechnician & "', '" & theReason & "', #" & theDateRequested & "#, #" & Date & "#);"
    CurrentDb.Execute sSQL, dbFailOnError
End Sub

Open in new window

0
 
LVL 20
ID: 41791483
ok -- in Excel, it would be good to make the result something meaningful. Currently, you do not even need it -- you could use CALL instead or not surround arguments with parentheses since there is not anything returned ... however, there could be.

In Access, in the RecreateTool_AddRecord code, Make it a function and return a boolean value of true or false
Public Function RecreateTool_AddRecord(  ...) as boolean

Open in new window

then instead of "CurrentDb.Execute sSQL, dbFailOnError"
with CurrentDb
   .Execute sSQL, dbFailOnError
   if .RecordsAffected >0 then
      RecreateTool_AddRecord =true
   else
      RecreateTool_AddRecord =false
   end if
end with 'currentdb

Open in new window

then in Excel:
if objAcc.Run( _
            "RecreateTool_AddRecord" _
            , theOriginalQuote _
            , theNewQuote _
            , theSiteGroup _
            , theTechnician _
            , theReason _
            , theDateRequested _
            ) <> true then
   if msgbox ("Error occurred on row " & nrow _
         & vbcrlf & "Do you want to stop?" _
         vbyesno, "Error -- stop?") = vbyes then
      go to proc_exit
   end if
end if

Open in new window

proc_exit would then be a line label added above the statement to release the Access object, which would be done after the message box
    MsgBox "Did up to row " & nRow - 1, , "Done"
Proc_Exit:
   on error resume next
   Set objAcc = Nothing

Open in new window

space underscore at the end of a line means the statement is continued on the next line

Error handling could also be added. To learn more:

1. basic error handling code for VBA (3:48)
http://www.experts-exchange.com/videos/1478/Excel-Error-Handling-Part-1-Basic-Concepts.html

2. Run and Fix Code Loop through rows of an Excel spreadsheet using VBA (6:00)
http://www.experts-exchange.com/videos/1498/Excel-Error-Handling-Part-2-VBA-to-Copy-Values-Down-to-Blank-Cells-in-an-Excel-Column.html

3. Error Handling Part 3 - Run and Fix Bugs (7:51)
http://www.experts-exchange.com/videos/1518/Excel-Error-Handling-Part-3-Run-and-Fix-Bugs.html
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:kbay808
ID: 41791562
I'm sorry, but I don't have any control over the Access DB.  Any changes would have to be in Excel.
0
 
LVL 20
ID: 41791567
it was only a suggestion ... the code I gave you should work fine.  Did you try it?
0
 

Author Comment

by:kbay808
ID: 41795166
The first code that you posted does not work.  I attached a screen shot of the error and the debug screen.  The error is on the Access DB side.  From what I understand, the updated data needs to be within the " " for the below line in order for it to work.    

Result = objAcc.run(" ")

Open in new window

Error.jpg
Debug.jpg
0
 

Author Comment

by:kbay808
ID: 41798910
I was thinking since the original code works for just 1 row/record, a workaround could be for the code to run for the first row (row 2) and then delete the row and then if cell A2 is not blank then run the code again and again until cell A2 is blank.
0
 

Accepted Solution

by:
kbay808 earned 0 total points
ID: 41813138
Here is what I came up with and it works perfect.
Sub modIncTool()
On Error Resume Next
Dim objAcc As Object
theOriginalQuote = Sheets("Export").Range("A2")
theNewQuote = Sheets("Export").Range("B2")
theSiteGroup = Sheets("Export").Range("F2")
theTechnician = Sheets("Export").Range("G2")
theReason = Sheets("Export").Range("H2")
theDateRequested = Sheets("Export").Range("I2")
Set objAcc = GetObject(, "Access.Application")
Result = objAcc.run("RecreateTool_AddRecord", theOriginalQuote, theNewQuote, theSiteGroup, theTechnician, theReason, theDateRequested)
Sheets("Export").Rows(2).EntireRow.Delete
If Sheets("Export").Range("A2") <> "" Then
    modIncTool
Else:

    Dim rng As Range, cell As Range
    Set rng = Sheets("Completed").Range("L2:L2000")

    For Each cell In rng
        cell = WorksheetFunction.Substitute(cell, "No", "Yes")
    Next
    AppActivate Application.Caption
    MsgBox ("Export Complete")
    Exit Sub
End If

Set objAcc = Nothing
End Sub

Open in new window

0
 

Author Closing Comment

by:kbay808
ID: 41819429
I created my own solution and posted it.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Modern/Metro styled message box and input box that directly can replace MsgBox() and InputBox()in Microsoft Access 2013 and later. Also included is a preconfigured error box to be used in error handling.
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

740 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question