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
18 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 19
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 19
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
 

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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 19
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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

762 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now