Transfer data from Acces to Excel, Initializing loop, Compare record

[noorani]

Please help me to solve the error in my code i have a problem with initializing the loop. please give me some advise thanks in advance.

My problem is, that i want to export data from Access into my Excel worksheet.

where first 3 columns in my Worksheet will contain the Product No, Product Code and Product Name. and i succeed to transfer this data, but after this process i want to transfer the query which holds the remaining quantity from my stock table and which holds some of same existing Product code which i have already transfered in my worksheet and find this same code in my whole first row,

for that i set the record set which work perfectly only problem occours when i want to loop my first column within range of my Worksheet and want to compare the Product code with the result of my query using recordset, if the Code exist in both i mean in my worksheet and in my query result, then i want to bring this data in my worksheet at the same row where this code exist and move my record set to next and repeat the same process until my record set reach to end of fie.

Here is the code. I have a problem in Block 3
=================================================

Private Sub hpseltoexcel_Click()
Dim xlBudgetSchedule As Excel.Application
Dim rwIndex As Integer
Dim currentRow As Integer
Dim currentColumn As Integer
Dim prodlist As Recordset
Dim realstock As Recordset
Dim dbs As Database
Dim title As String
Set dbs = CurrentDb
title = "BackOffice!"

'=======================================================
Block 1:
in this Block i'm setting up the heading of first three columns and transfering the data to my Excel Worksheet using ReocrdSet.
'========================================================

Set xlBudgetSchedule = New Excel.Application
xlBudgetSchedule.Visible = True
xlBudgetSchedule.Workbooks.add
xlBudgetSchedule.ActiveWindow.DisplayGridlines = True 'show grid lines
With xlBudgetSchedule.ActiveSheet
.Cells(2, 1).Value = "Inernal Code"
.Cells(2, 2).Value = "Vender Code"
.Cells(2, 3).Value = "Product Name"
End With
currentRow = 3
currentColumn = 1
Set prodlist = dbs.OpenRecordset("select * from products where (VenderID = 4)ORDER BY Hp_ProductName", dbOpenDynaset)
If prodlist.RecordCount > 0 Then
Do Until prodlist.EOF
With xlBudgetSchedule.ActiveSheet
.Cells(currentRow, currentColumn).Value = prodlist!productid
.Cells(currentRow, currentColumn + 1).Value = prodlist!Hp_ProductName
.Cells(currentRow, currentColumn + 2).Value = prodlist!product_name
.Cells(currentRow, currentColumn).HorizontalAlignment = xlLeft
currentRow = currentRow + 1
currentColumn = 1
End With
prodlist.MoveNext
Loop
End If

'=======================================================
Block 2:
in this Block i'm setting up the heading of 4th column and transfering the data to my Excel Worksheet Using RecordSet.
'========================================================


With xlBudgetSchedule.ActiveSheet
.Cells(2, 4).Value = "Stock Remaining"
End With
currentRow = 3
currentColumn = 4
Set realstock = dbs.OpenRecordset(" SELECT HPresterquery.ProductID, HPresterquery.SumOfquantity FROM HPresterquery", dbOpenDynaset)
If realstock.RecordCount > 0 Then
Do Until realstock.EOF
Dim lRow As Long
With xlBudgetSchedule.ActiveSheet
For lRow = Range("A65536").End(xlUp).Row To 1 Step -1
'=======================================================
Block 3:
Here i have problem i can not compare the resulf of my record set with in my workshee range column.
'========================================================


If Range("A" & lRow & ":A" & lRow).Find(realstock!productid, LookIn:=xlValues, lookat:=xlWhole) Then
.Cells(Rows(lRow), currentColumn).Value = realstock!SumOfquantity
End If
Next
End With
realstock.MoveNext
Loop
End If

realstock.Close
prodlist.Close
dbs.Close
'Caption stuff
xlBudgetSchedule.ActiveSheet.Name = "HPSellout"
xlBudgetSchedule.ActiveWindow.Caption = "HPSellout"
xlBudgetSchedule.Application.Caption = "HPSellout"
xlBudgetSchedule.Application.DisplayFormulaBar = True
xlBudgetSchedule.ActiveWindow.DisplayFormulas = True
xlBudgetSchedule.ActiveWindow.DisplayHeadings = True
xlBudgetSchedule.ActiveWindow.DisplayZeros = True
End Sub
==========================================
End of code
==========================================

Please put me on right track thank in advance.

 

[smuckers]

Good afternoon noorani:

After reviewing your code and your problem statement, I think I can help. Unfortunately, I do not believe that there is only one problem. I offer to you a series of code tests to try. The result will be this problem being resolved or determing that Excel is not the issue. I apologize in advance for this lengthy explanation.

When using Automation, many interactions occur between the MS Access and MS Excel applications. Let's sort this problem out first, like a puzzle, and look for the missing pieces and a starting point for the code tests.

What do you know?
1. Code demonstrates solid knowledge in creating an Excel object from Access.

2. Code demonstrates that transfer of data is not the problem.

3. Code demonstrates that populating a recordset with the SQL query is most likely correct and not an issue either.

4. Setting up of the 4th column with data seems to work.

What are some of the missing pieces?
1. I am unable to follow where the cursor focus is and as a result, unable to determine if Excel or Access VBA is needed.

2. Not sure if the method used for enumerating the Range specified for the Product Code is correct.

3. Not sure if comparison between the 2 columns, Product Code and Stock Remaining(column 4) columns is functional.

My proposed solution is to concentrate on clarifying these 3 unknowns within the Excel environment. The reasoning is that your code demonstrates a high skill and knowledge level with Access and most likely is not the source of the problem.

Here goes:

I've broken this down into three parts:
1. Naming of your ranges.
2. Enumerating your ranges.
3. Comparing your ranges.

Note: I almost forgot. Place some sample data in Columns 2 and 4 on Sheet1.

1. With Excel open, press Alt+F11 and split your computer screen in two.
2. Paste the code below into a new module called basCommon.
3. On the left side of the computer screen, show the Excel spread sheet.
4. On the right side, show your code.
5. Place your cursor inside the Wrapper Function and then step through the code pressing F8.
6. You will see the program work as you step through the code at the same time. (I always think that is neat! )


Option Explicit
' **** Start the program by placing cursor inside
' **** of the Wrapper function code and pressing F8

Public Function Wrapper()

NameMyRanges
TestRange

End Function

Public Function NameMyRanges()
ActiveWorkbook.Names.Add NAME:="ProductCode", RefersToR1C1:="=Sheet1!R1C2:R100C2"
ActiveWorkbook.Names.Add NAME:="StockRemaining", RefersToR1C1:="=Sheet1!R1C4:R100C4"

End Function

Public Function TestRange()
' This routine only increments the ProductCode range.
Dim R As Range
Dim strSheetName As String

strSheetName = "Sheet1"
Sheets(strSheetName).Select
' If there are a lot of rows, set this value to false
' to speed up the code.
Application.ScreenUpdating = True

For Each R In Range("ProductCode")
R.Select
' Call the Comparison Function,
If Not IsEmpty(ActiveCell.Value) Then
Comparison (ActiveCell.Value)
End If

Next
End Function

Public Function Comparison(ProductCodeValue)
Dim rngStock As Range
Dim strValue As String
Dim strName As String
Dim R As Range
Dim strTempAddress As String

strName = Trim(ProductCodeValue)
' This checks and compares the first 3 characters.
' Not necessary but there if you need it.
' strName = Mid$(strName, 1, 3)

Sheets("Sheet1").Select

For Each rngStock In Range("StockRemaining")
rngStock.Select
If InStr(1, ActiveCell.Value, strName) > 0 Then
strName = Trim(ActiveCell.Value)
Comparison = strName
MsgBox "Congradulations, You found a match!"
' Make your changes here if there is a match

Else
'Comparison = CustomerName
End If
Next rngStock
End Function

Conclusion:

If the ranges are properly named, the cells properly selected within the ranges and the comparison function works, then I think you are very close to solving this puzzle.

Good luck and let me know if you have any further questions.

Sincerely,

Smuckers

May your hysterical randomness be cured!

 

[noorani]

Thanks Smuckers for your detail explanation i really appreciate it, today i'm going to work with your solution and let you know the results.
Once again thank you very much for spending your crucial time on my question and i'm sure that your explanation will going to put me on right track.

Sincerely,

Noorani.

 

[vedicman]

noorani

When working with Access data that populates an XL spreadsheet, I prefer to run queries from a code module in XL. If interested I will supply code samples to accomplish this. It greatly simplifies maintenance because everything is in one place.

Franco