Solved

2 Variable column starting points on looping routine involving Access 2010

Posted on 2013-06-27
6
196 Views
Last Modified: 2013-07-10
vba excel 2010
Access 2010 backend.

In the code below I'm using  2 static Columns and starting point cells for a looping routine using the data in the range specified.

Example:  Columns "H" AND I"  at cell 2 are always my starting points.

h2 and i2

Column H contains a Name
Column I contains a alphanumeric number


keepgoing = True
ActiveCell.Select
' status bar
Application.StatusBar = True
Application.StatusBar = "Processing Please Wait........"

Do While keepgoing = True
STSAVEMODELNUMBER = UCase(Trim(ActiveCell.Offset(0, 1).Formula)) '  CUST NUMBER

stSaveNAME = UCase(Trim(ActiveCell.Offset(O, O).Formula)) '  cust name

Open in new window

What I Have:
For these 2 new starting points I'am asking for a ColumnLetter and Number for both entries.

code here and is working fine.
Dim r As Range

vNameColumn = UCase(InputBox("What is the Intersect of The Vendor Name Column and Row: Example -  A2 "))

MyFile = "C:\Program Files\Crs\iData\Defaults\" & "Intersect_VendorName_Worksheet.txt"
Fnum = FreeFile()
Open MyFile For Output As Fnum
Print #Fnum, vNameColumn
Close #Fnum
If vNameColumn = "" Then
MsgBox "Please Determine Your Intersect Point!", vbCritical
Exit Function
End If

MsgBox (vNameColumn)


vNumberColumn = UCase(InputBox("What is the Intersect of The Vendor Number Column and Row: Example -  A2 "))
MyFile = "C:\Program Files\Crs\iData\Defaults\" & "Intersect_VendorNumber_Worksheet.txt"
Fnum = FreeFile()
Open MyFile For Output As Fnum
Print #Fnum, vNumberColumn
Close #Fnum

Open in new window


those value get stored in a text file for me on something later.

The values change for every project i work on.

Example: Could be    E4 B4,
J3  I3,
The first is always the Mfgname column the second is always the mfrnumber column


 The sql is this:

'DATABASE NOW 2013
Source = "SELECT tblXrefInfo.Item, tblXrefInfo.MFRNAME, tblXrefInfo.MFRNUM, WwgCore.RICHTEXT, WwgCore.WWGDESC, tblXrefInfo.XREF, WwgCore.COMMENTS, WwgCore.SPIN, WwgCore.REDBOOKNUM, "
Source = Source & "SapAltData.ALT1, SapAltData.ALT1XREFTYPE, SapAltData.ALT1COMMENTS, SapAltData.ALT1SPIN, SapAltData.ALT1MFGNAME, SapAltData.ALT1MFRNUM, SapAltData.ALT1DESC, SapAltData.ALT1DESC2, SapAltData.ALT1BOOKPAGE, WwgCore.WWGMFRNAME, WwgCore.WWGMFRNUM, SapAltData.ALT1DESC2, WwgCoreExtra.GREENProduct, WwgCoreExtra.PRIVATE_LABEL, WwgCoreExtra.SEGMENT, WwgCore.WA_PRICE"
Source = Source & " FROM ((tblXrefInfo LEFT JOIN SapAltData ON tblXrefInfo.Item = SapAltData.ITEM) LEFT JOIN WwgCore ON tblXrefInfo.Item = WwgCore.ITEM) LEFT JOIN WwgCoreExtra ON tblXrefInfo.Item = WwgCoreExtra.ITEM  WHERE MFRNUM = '" & STSAVEMODELNUMBER & "'  AND MFRNAME  = '" & stSaveNAME & "' ORDER BY WwgCore.SPIN,WwgCore.XREF"


So What Do I need:

I need to be able to still loop through this routine. using the entries asked for in the above input boxes.

so i Know where my new Starting points are for My 2 variable columns .

and the routine using the correct values as it loops through all the cells.


I posted the whole code attached.



Thanks
fordraiders
Determine-Variable-For-NewRoutin.txt
0
Comment
Question by:fordraiders
  • 3
  • 2
6 Comments
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
ID: 39287994
In this version of your routine, I've done the following:
* removed unnecessary Range("A1"). when following an Offset() range reference.
* changed some .Formula = to .Value =
* set the .Interior.ColorIndex for a range instead of setting it for individual cells on multiple statements
* substituted the column names for the field numbers when you are accessing the field values in your recordset variable
* commented out a block of duplicated code
* changed series of If statements to a single Select Case statement.
* corrected non-numeric parameters of Offset() reference
original: UCase(Trim(ActiveCell.Offset(O, O).Formula))  'yes

Question:
* Where are the Dim/public/private or Const statements for such variables as iCounter, stSaveDescription, DiscdGrainger and DiscdVendor?
* Where and what are the missing routines:
ClearFormats()
delRowsCondition()
HideColumns()
HIDEROWS2()
Macro1()
Macro3()
FillColBlanksOrSpaces()
RegisterDatabaseR()
RegisterDatabaseX()
ReplaceColText()



Public Sub Q_28170077()
    Dim stMODELNUMBER As String
    Dim stMFGNAME As String
    Dim STSAVEMODELNUMBER As String
    Dim stBrand As String
    Dim stSaveCustnum As String
    Dim Source As String
    Dim Connect As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim FindTxt As String
    Dim WwgSt As String
    Dim GpartTxt As String
    Dim DiscdSpin As String
    Dim DasbrSpin As String
    Dim SubupSpin As String
    Dim TempsSpin As String
    Dim DeadiSpin As String
    
    ' NEW CONNECTION
    Dim FC As Long
    Dim keepgoing As Boolean
    Dim stMaterial As String
    Dim stVendorNumber As String
    Dim StVendorName As String
    Dim vVendorPrice As Variant
    Dim vCSSP As Variant
    Dim iRecordNo As Double
    Dim textstring As Variant
    Dim vresult As Variant
    Dim startime, endtime As Date
    Dim x As Long
    Dim stDatabasePath As String
         '***************** connection PATH for Laptop
    stDatabasePath = "C:\Program Files\Crs Enterprise\EnterpriseDatabases\Enterprise_2013_Update.accdb"
    
    FillColBlanksOrSpaces '  ok for 2010 in description
    
    RegisterDatabaseR
    RegisterDatabaseX
    ReplaceColText
    ClearFormats
    Macro3
    FindTxt = " :Order From Findmro"
    WwgSt = " :Order From Gcom"
    GpartTxt = " : Order From Gparts"
    DiscdSpin = " :Item Discontinued. Seek Possible Alternate"
    DasbrSpin = " :Item Discontinued. Seek Possible Alternate"
    SubupSpin = " :Item Discontinued. Seek Possible Alternate"
    TempsSpin = " :Item Discontinued. Seek Possible Alternate"
    DeadiSpin = " :Item Discontinued. Seek Possible Alternate"
    startime = Now
    RegisterDatabaseR ' REPLACE 97
    RegisterDatabaseX ' SAPBACKEND1
    GoTo LINE2:
    'End If
    '*******
    On Error GoTo HANDLEERROR
         
    ' NEW CONNECTION
         '***************** connection PATH for Laptop
LINE1:
         '***************** connection for SERVER
    Connect.ConnectionString = "DSN=Quotes;UID=user;PWD=user;"
    Connect.CursorLocation = adUseClient
    Connect.Open
         '***************** connection for SERVER
    GoTo LINE4:
         '***************** connection PATH for Laptop
LINE2:
         '***************** connection for SERVER
    Connect.ConnectionString = "DSN=Enterprise_2013;UID=user;Password=123QQxx0919AZAZazaz;"
    Connect.CursorLocation = adUseClient
    Connect.Open
    
    
       
         '***************** connection for SERVER
    GoTo LINE4:
        
LINE3:
         '***************** connection for Laptop
    
         
    Connect.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                   "Data Source=C:\Program Files\Crs Enterprise\EnterpriseDatabases\Enterprise_2013_Update.accdb"
         
         
         
         
         '***************** connection for Laptop
    
LINE4:
    '*****
    rs.ActiveConnection = Connect
    
    
    
    vresult = MsgBox("Do you want Mfgname and Mfrnumber matches only? (answer Yes) " & vbCrLf & "If you want only Mfrnum matches (answer No)", vbYesNo, "Xref Choice")
    ' SET SELECTION IN CASE THEY DON'T
    Cells(2, 8).Select
    
    ' RESET COLUMN MAKE TEXT ONLY
    Macro1
    ' RESET SELECTION
    Cells(2, 8).Select
    
    keepgoing = True
    ActiveCell.Select
    ' status bar
    Application.StatusBar = True
    Application.StatusBar = "Processing Please Wait........"
    
    Do While keepgoing = True
        stBrand = Trim(ActiveCell.Formula)
        ActiveCell.Offset(0, 1).Formula = "'" & ActiveCell.Offset(0, 1).Formula
        STSAVEMODELNUMBER = UCase(Trim(ActiveCell.Offset(0, 1).Formula)) '  CUSTOMER NUMBER
        stSaveDescription = Trim(ActiveCell.Offset(0, 2).Formula) 'CUSTOMER DESC
        stSaveNAME = UCase(Trim(ActiveCell.Offset(0, 0).Formula))  ' yes
        stSaveCustnum = Trim(ActiveCell.Offset(0, -1).Formula) ' SAVE CUSTOMER MFGNUMBER INFO
        If STSAVEMODELNUMBER = "" And stBrand = "" Then
            'If STSAVEMODELNUMBER = "" And stSaveNAME = "" Then
            
            keepgoing = False
            GoTo stoplooping
        Else
            ActiveCell.Offset(1, 0).Range("A1").Select
        End If
        iCounter = iCounter + 1
        
        If iCounter < 5 Then
            Processing_Dialog.lblMessage.Caption = "Jumping To Warp 3 Hang On!.....  " & Application.StatusBar
            Processing_Dialog.Repaint
            
            'Save the spreadsheet
            ActiveWorkbook.Save
            iCounter = iCounter
        End If
        
        If vresult = vbYes Then
        
            'enterprise DATABASE NOW 2013
            Source = "SELECT tblXrefInfo.Item, tblXrefInfo.MFRNAME, tblXrefInfo.MFRNUM, WwgCore.RICHTEXT, WwgCore.WWGDESC, tblXrefInfo.XREF, WwgCore.COMMENTS, WwgCore.SPIN, WwgCore.REDBOOKNUM, "
            Source = Source & "SapAltData.ALT1, SapAltData.ALT1XREFTYPE, SapAltData.ALT1COMMENTS, SapAltData.ALT1SPIN, SapAltData.ALT1MFGNAME, SapAltData.ALT1MFRNUM, SapAltData.ALT1DESC, SapAltData.ALT1DESC2, SapAltData.ALT1BOOKPAGE, WwgCore.WWGMFRNAME, WwgCore.WWGMFRNUM, SapAltData.ALT1DESC2, WwgCoreExtra.GREENProduct, WwgCoreExtra.PRIVATE_LABEL, WwgCoreExtra.SEGMENT, WwgCore.WA_PRICE"
            Source = Source & " FROM ((tblXrefInfo LEFT JOIN SapAltData ON tblXrefInfo.Item = SapAltData.ITEM) LEFT JOIN WwgCore ON tblXrefInfo.Item = WwgCore.ITEM) LEFT JOIN WwgCoreExtra ON tblXrefInfo.Item = WwgCoreExtra.ITEM  WHERE MFRNUM = '" & STSAVEMODELNUMBER & "'  AND MFRNAME  = '" & stSaveNAME & "' ORDER BY WwgCore.SPIN,WwgCore.XREF"
        
        Else
        
        
            'enterprise DATABASE NOW 2013
            Source = "SELECT tblXrefInfo.Item, tblXrefInfo.MFRNAME, tblXrefInfo.MFRNUM, WwgCore.RICHTEXT, WwgCore.WWGDESC, tblXrefInfo.XREF, WwgCore.COMMENTS, WwgCore.SPIN, WwgCore.REDBOOKNUM, "
            Source = Source & "SapAltData.ALT1, SapAltData.ALT1XREFTYPE, SapAltData.ALT1COMMENTS, SapAltData.ALT1SPIN, SapAltData.ALT1MFGNAME, SapAltData.ALT1MFRNUM, SapAltData.ALT1DESC, SapAltData.ALT1DESC2, SapAltData.ALT1BOOKPAGE, WwgCore.WWGMFRNAME, WwgCore.WWGMFRNUM, SapAltData.ALT1DESC2, WwgCoreExtra.GREENProduct, WwgCoreExtra.PRIVATE_LABEL, WwgCoreExtra.SEGMENT, WwgCore.WA_PRICE"
            Source = Source & " FROM ((tblXrefInfo LEFT JOIN SapAltData ON tblXrefInfo.Item = SapAltData.ITEM) LEFT JOIN WwgCore ON tblXrefInfo.Item = WwgCore.ITEM) LEFT JOIN WwgCoreExtra ON tblXrefInfo.Item = WwgCoreExtra.ITEM  WHERE MFRNUM = '" & STSAVEMODELNUMBER & "' ORDER BY WwgCore.SPIN,WwgCore.XREF"
        
        
        End If
        
        
        rs.Open Source, Connect, adOpenKeyset, adLockOptimistic
        If rs.EOF = True Then
            ActiveCell.Offset(-1, 16).Value = "NOT FOUND"
            ActiveCell.Offset(-1, -7).Value = "NOT FOUND"
        
            '' POSTING NOT FOUNDS
            If ActiveCell.Offset(-1, 16).Value = "NOT FOUND" Then
                ActiveCell.Offset(-1, -5).Value = stSaveNAME ' MFGNAME
                ActiveCell.Offset(-1, -4).Value = STSAVEMODELNUMBER ' MFGNUMBER
                ActiveCell.Offset(-1, -3).Value = stSaveDescription ' CUSTOMER DESC
                ActiveCell.Offset(-1, -6).Value = stSaveCustnum 'CUSTOMER PARTNUM
                
                ' color for seperation
                ActiveSheet.Range(ActiveCell.Offset(-1, -7), ActiveCell.Offset(-1, 12)).Interior.ColorIndex = 15
                
                ' NULL THE ORIGINAL FIELDS
                ActiveCell.Offset(-1, 0).Value = "NO DATA"
                'ActiveCell.Offset(-1, 1).Value = ""
                ActiveCell.Offset(-1, 2).Value = ""
                ActiveCell.Offset(-1, -1).Value = ""
                ActiveCell.Offset(-1, -2).Value = "NO DATA" ' REDBOOKNUM
            
            End If
        End If
        ' POST NO DATA FOR ALTERNATES
        ' ALT1
        ActiveCell.Offset(-1, 18).Value = "noAlt"
        ' ALT2
        'ActiveCell.Offset(-1, 23).Range("A1").Value = "noAlt"
        ' ALT3
        'ActiveCell.Offset(-1, 32).Range("A1").Value = "noAlt"
        If rs.EOF = False Then
            ActiveCell.Offset(-1, 16).Value = "FOUND"
            '' POSTING FOUNDS
            ActiveCell.Offset(-1, -5).Value = stSaveNAME ' MFGNAME
            ActiveCell.Offset(-1, -4).Value = STSAVEMODELNUMBER ' MFGNUMBER
            ActiveCell.Offset(-1, -3).Value = stSaveDescription ' CUSTOMER DESC
            ActiveCell.Offset(-1, -6).Value = stSaveCustnum 'CUSTOMER PARTNUM
        End If
        
        Do While rs.EOF = False
            ActiveCell.EntireRow.Insert ' insert a row to preserve original values
            x = iCounter + 1
            Application.StatusBar = x
            Processing_Dialog.lblMessage.Caption = "Processing Request Please Wait.....  " & Application.StatusBar
            Processing_Dialog.Repaint
            Processing_Dialog.lblTime.Caption = Time
            Processing_Dialog.Repaint
            'setformulas
            ActiveCell.Offset(0, -2).Value = rs.Fields("Item").Value & "   $" & rs.Fields("WA_PRICE").Value 'ITEM
            ActiveCell.Offset(0, 0).Value = rs.Fields("MFRNAME").Value 'MFGNAM
            ActiveCell.Offset(0, 1).Value = rs.Fields("MFRNUM").Value 'MFRNUM
            ActiveCell.Offset(0, 2).Value = rs.Fields("RICHTEXT").Value 'WWGDESC
            ActiveCell.Offset(0, 3).Value = rs.Fields("WWGMFRNAME").Value 'WWGMFRNAM
            ActiveCell.Offset(0, 4).Value = rs.Fields("WWGMFRNUM").Value 'WWGMFGNUM
            ActiveCell.Offset(0, 5).Value = rs.Fields("WWGDESC").Value 'ADDESC
            ActiveCell.Offset(0, 9).Value = rs.Fields("REDBOOKNUM").Value 'REDBOOKNUM
            ' standard gcom returns
            ActiveCell.Offset(0, 6).Value = rs.Fields("XREF").Value 'XREFTYPE
            ' Take care of manually added by trigger
            ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & WwgSt) 'COMMENTS
            ActiveCell.Offset(0, 8).Value = rs.Fields("SPIN").Value 'SPIN
            
            ActiveCell.Offset(0, 1).Interior.ColorIndex = 0
            ' set cell color to green
            If Trim(STSAVEMODELNUMBER) = Trim(rs.Fields("MFRNUM").Value) Then
                ActiveCell.Offset(0, 1).Interior.ColorIndex = 4
                ActiveCell.Offset(0, 16).Value = "ITEM FOUND"
                'ActiveCell.Offset(0, -7).Range("A1").Value = "Y" ' CODED YES
            End If
            ' tagging for Mfgname and number matches
            'If vresult = vbYes Then
            'ActiveCell.Offset(0, -7).Range("A1").Value = "Y" ' CODED YES
            'End If
            
            
            ' FOR FINDMRO DATA RETURNS
            If ActiveCell.Offset(0, 8).Value = "FINDMRO" Then
                ActiveCell.Offset(0, 41).Value = rs.Fields("MFRNAME").Value 'Souced MFGNAM
                ActiveCell.Offset(0, 42).Value = rs.Fields("MFRNUM").Value 'Sourced MFRNUM
                
                ActiveCell.Offset(0, 1).Interior.ColorIndex = 7 'MFRNUM
                
                ActiveCell.Offset(0, 15).Value = "FINDMRO"
                ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & FindTxt) 'COMMENTS
            End If
            ' frndmro no founds
            If ActiveCell.Offset(0, -2).Value = "" Then
                ActiveCell.Offset(0, -2).Value = "FINDMRO"
            End If
            ' GPARTS FINDS
            If ActiveCell.Offset(0, 8).Value = "GPARTS" Then
                ActiveCell.Offset(0, 15).Value = "GPARTS"
                ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & GpartTxt) 'COMMENTS
                
                ActiveCell.Offset(0, 1).Interior.ColorIndex = 6
                
                'ActiveCell.Offset(0, -7).Value = "Y" ' CODED YES
            End If
            ' gparts no founds
            If ActiveCell.Offset(0, -2).Value = "" Then
                ActiveCell.Offset(0, -2).Value = "GPARTS"
            End If
            ' coloring for seperation
            If ActiveCell.Offset(-1, 16).Value = "FOUND" Then
                ActiveSheet.Range(ActiveCell.Offset(-1, -7), ActiveCell.Offset(-1, 12)).Interior.ColorIndex = 15
            End If
            ' ALTERNATE 1 STUFF
            ActiveCell.Offset(0, 18).Value = rs.Fields("ALT1").Value 'WWGALT1
            ActiveCell.Offset(0, 19).Value = rs.Fields("ALT1MFGNAME").Value 'WWGMFGNAM1
            ActiveCell.Offset(0, 20).Value = rs.Fields("ALT1MFRNUM").Value 'WWGMFRNUM1
            ActiveCell.Offset(0, 21).Value = rs.Fields("ALT1DESC").Value 'WWGDESC1
            ActiveCell.Offset(0, 22).Value = rs.Fields("ALT1DESC2").Value 'ADDESC1
            ActiveCell.Offset(0, 23).Value = rs.Fields("ALT1COMMENTS").Value 'COMMENTS1
            ActiveCell.Offset(0, 24).Value = rs.Fields("ALT1SPIN").Value 'SPIN1
            ActiveCell.Offset(0, 25).Value = rs.Fields("ALT1BOOKPAGE").Value 'REDBOOKNUM
            'ActiveCell.Offset(0, 19).Range("A1").Value = rs.Fields(10).Value 'XREFTYPE1
            
            ' posting no data
            If ActiveCell.Offset(0, 18).Value = "" Then
                ActiveCell.Offset(0, 18).Value = "noAlt"
            End If
            ' POSTINGS FOR SPIN CODES
            ' DISCD SUBUP DASBR TEMPS
            Select Case ActiveCell.Offset(0, 8).Value
                Case "DG"
                    ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & DiscdGrainger) 'COMMENTS
                Case "DV"
                    ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & DiscdVendor) 'COMMENTS
                Case "WG"
                    ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & DiscdGrainger) 'COMMENTS
                Case "WH"
                    ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & DiscdWharehouse) 'COMMENTS
                Case "WS"
                    ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & DiscdSupplier) 'COMMENTS
                Case "WV"
                    ActiveCell.Offset(0, 7).Value = Trim(rs.Fields("COMMENTS").Value & DiscdVendor) 'COMMENTS
            End Select
            If ActiveCell.Offset(0, 16).Value <> "noAlt" Then
                ActiveCell.Offset(0, 16).Font.Color = vbRed
            End If
            ' POSTINGS FOR SPIN CODES
            ' DISCD SUBUP DASBR TEMPS
'            If ActiveCell.Offset(0, 8).Value = "DG" Then 'SPIN
'               ActiveCell.Offset(0, 7).Value = Trim(rs.Fields(6).Value & DiscdGrainger) 'COMMENTS
'            End If
'            If ActiveCell.Offset(0, 8).Value = "DV" Then 'SPIN
'               ActiveCell.Offset(0, 7).Value = Trim(rs.Fields(6).Value & DiscdVendor) 'COMMENTS
'            End If
'            If ActiveCell.Offset(0, 8).Value = "WG" Then 'SPIN
'               ActiveCell.Offset(0, 7).Value = Trim(rs.Fields(6).Value & DiscdGrainger) 'COMMENTS
'            End If
'            If ActiveCell.Offset(0, 8).Value = "WH" Then 'SPIN
'               ActiveCell.Offset(0, 7).Value = Trim(rs.Fields(6).Value & DiscdWharehouse) 'COMMENTS
'            End If
'            If ActiveCell.Offset(0, 8).Value = "WS" Then 'SPIN
'               ActiveCell.Offset(0, 7).Value = Trim(rs.Fields(6).Value & DiscdSupplier) 'COMMENTS
'            End If
'            If ActiveCell.Offset(0, 8).Value = "WV" Then 'SPIN
'               ActiveCell.Offset(0, 7).Value = Trim(rs.Fields(6).Value & DiscdVendor) 'COMMENTS
'            End If
            ' ALTERNATE 2 STUFF
            
            ' posting no data
            'If ActiveCell.Offset(0, 23).Value = "" Then
            'ActiveCell.Offset(0, 23).Value = "noAlt"
            'End If
'            If ActiveCell.Offset(0, 16).Value <> "noAlt" Then
'            ActiveCell.Offset(0, 16).Font.Color = vbRed
'            End If
            
            ' ALTERNATE 3 STUFF
            
            ' posting no data
            
            If ActiveCell.Offset(0, 16).Value <> "noAlt" Then
                ActiveCell.Offset(0, 16).Font.Color = vbRed
            End If
            ActiveCell.Offset(0, -5).Value = stSaveNAME
            ActiveCell.Offset(0, -4).Value = STSAVEMODELNUMBER
            ActiveCell.Offset(0, -3).Value = stSaveDescription
            ActiveCell.Offset(0, -6).Value = stSaveCustnum
            ActiveCell.Offset(1, 0).Select
            rs.MoveNext
            iCounter = iCounter + 1
        Loop
        rs.Close
        iCounter = iCounter + 1
        
        If iCounter <= 10 Then
            Processing_Dialog.lblMessage.Caption = "Still Processing Request Please Wait.....  " & Application.StatusBar
            Processing_Dialog.Repaint
            'Save the spreadsheet
             '   ActiveWorkbook.Save
            iCounter = iCounter
        End If
        
        'If ActiveCell.Formula = "" Then
        If STSAVEMODELNUMBER = "" And stBrand = "" Then
            keepgoing = False
        End If
    Loop
stoplooping:
    Set rs = Nothing
    
    ' LOOK FOR FUNCTIONAL CHOICE
    If vresult = vbYes Then
        delRowsCondition
    Else
    End If
    
    ' HIDE THE UNNECESSARY STUFF
    HideColumns
    HIDEROWS2
    
    Application.StatusBar = "We Are Done......!"
    endtime = Now
    MsgBox ("Process Completed. Completion Time ..." & Hour(endtime - startime) & " h " & Minute(endtime - startime) & " m " & Second(endtime - startime) & " seconds"), vbInformation, "Cross Reference Process Time"
    Application.StatusBar = False
    
    
    Cells(3, 2).Select ' CURRENT CELL
ExitHere:
    Exit Sub
HANDLEERROR:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
     "Customer Mfgname and Mfgnumber Xref"
    Resume ExitHere
End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 39288001
In lines 234-260, there appears to be some logical errors in what you are checking for FINDMRO and GPARTS and what you do if you don't find those values.
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39298268
wow and Thanks !

The other routines are not necessary for this question.
the findmro anfd gparts can be omitted also..

I will check this out and let you know...
0
 
LVL 3

Author Comment

by:fordraiders
ID: 39298269
sorry my email address was not correct.
0
 
LVL 3

Author Closing Comment

by:fordraiders
ID: 39314400
Thanks...
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
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…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

758 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

19 Experts available now in Live!

Get 1:1 Help Now