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
19 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
time format showing wrong 12 49
Resizing every other graphic 3 13
Merging-Splitting-Multiple-Rows 33 42
Excel Save As Status Box will not go away 6 16
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
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 in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

932 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

11 Experts available now in Live!

Get 1:1 Help Now