Go Premium for a chance to win a PS4. Enter to Win

x
?
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
Medium Priority
?
36 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
  • 6
  • 3
9 Comments
 
LVL 23
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 23
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

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 23
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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

772 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