Performance and doing things right!

[onpnt]

Hi all,

I've manage with reading and checking out examples on the net to get the output I want from my first crack at this.

Please reference thread707-1284165 for an explanation on my situation and the process I need.

In short sense that thread is a bit confusing I need to update an xls from another xls by a unique identifier in the form of a material number.

So again with some code posted online like the new workbook function and find_first function I've managed to get everything going for my testing sessions and basically proof of abilities to myself before going further. I now would like to ask for input on doing this right. ;-) The looping one after another is killing me. I haven't structured anything yet so that is not an issue sense this is the test code but I know I'm not using the objects.methods correctly from what I've read but to be honest I couldn't get it to work in a timely manner and I have about 1.5 days (business) to do this so I hacked this together. One thing to note. the business specifications have been set that the users xls's that match as far as which will update the other will stay in the format stated. So when you see references to exact columns and such even knowing in my gut I know they will change and it will cause a code change needed, for now I'm willing to go with static references.

To prevent a long posting of code I'm posting the main sections that do the work. Keep in mind the For Next happens 6 times whic is the part I do not like.

Functions credited to Find_First and NewWorkbook

Function NewWorkbook(wsCount As Integer) As Workbook
Dim OriginalWorksheetCount As Long
    Set NewWorkbook = Nothing
    If wsCount < 1 Or wsCount > 255 Then Exit Function
    OriginalWorksheetCount = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = wsCount
    Set NewWorkbook = Workbooks.Add
    Application.SheetsInNewWorkbook = OriginalWorksheetCount
End Function

Function Find_First(col As String, sht As Worksheet, mNumber As String)
    Dim rng As Range

        With sht.Range(col)
            Set rng = .Find(What:=mNumber, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                Find_First = "Match found for " & rng & " at indexes (" & rng.Row & "," & rng.Column & ")"
            Else
                Find_First = "No match found"
            End If
        End With
End Function

Then here is the top portion of the processing code. It goes on running through 5 more columns though.

Dim wb As Workbook
Dim errorSheet As Worksheet
Dim wBook_IBG As Workbook
Dim wBook_CS As Workbook
Dim wBook As Workbook

Set wb = NewWorkbook(1)

Set errorSheet = wb.ActiveSheet

    Set wBook_IBG = Workbooks.Open("NeedUpdating.xls")
        If wBook_IBG Is Nothing Then
            Set wBook_IBG = Nothing
        Else
            Set wBook_IBG = Nothing
        End If

    Set wBook_CS = Workbooks.Open("Updater.xls")
        If wBook_CS Is Nothing Then
            Set wBook_CS = Nothing
        Else
            Set wBook_CS = Nothing
        End If
    
    Dim wSheet_CS As Worksheet
    Set wSheet_CS = wBook_CS.ActiveSheet
    Dim wSheet_IBG As Worksheet
    Set wSheet_IBG = wBook_IBG.ActiveSheet
  
   
    Dim topCel As Range
    Dim bottomCel As Range
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim x As Integer
    Dim i As Integer
    Dim numofRows As Integer
    
    x = 1
    
    Set topCel = wSheet_CS.Range("F1")
    Set bottomCel = wSheet_CS.Range("F" & wSheet_IBG.UsedRange.Rows.Count)
    If topCel.Row > bottomCel.Row Then End
    Set sourceRange = wSheet_CS.Range(topCel, bottomCel)
     
    numofRows = sourceRange.Rows.Count
  
    For i = 1 To numofRows
        If Application.IsNumber(sourceRange(i)) Then
            errorSheet.Cells(x, 2).Value = sourceRange(i)
            errorSheet.Cells(x, 3).Value = _
            Find_First("B:B", wSheet_IBG, wSheet_CS.Cells(i, 1))
            x = x + 1
        End If
    Next

Give me your best rips on the code. Please.

my output is as such

99.999	Match found for 108402 at indexes (2769,2)	99.999	Match found for 108402 at indexes (2769,2)
99.999	Match found for 140402 at indexes (1092,2)	99.999	Match found for 140402 at indexes (1092,2)
99.999	Match found for 150300 at indexes (643,2)	99.999	Match found for 150300 at indexes (643,2)

and so one


____________ signature below ______________
General FAQ faq333-2924
5 steps to asking a question faq333-3811

 

[HughLerwill]

onpnt,

re your <<It goes on running through 5 more columns though.>>

It would be useful for us if you could include the code used for the next couple of columns or all columns if the code does not repeat almost exactly.

regards Hugh,

 

[onpnt]

Greetings HughLerwill

I do not have the code at hand but the only difference is the column reference as such

    Set topCel = wSheet_CS.Range("H1")
    Set bottomCel = wSheet_CS.Range("H" & wSheet_IBG.UsedRange.Rows.Count)
    If topCel.Row > bottomCel.Row Then End
    Set sourceRange = wSheet_CS.Range(topCel, bottomCel)
     
    numofRows = sourceRange.Rows.Count
  
    For i = 1 To numofRows
        If Application.IsNumber(sourceRange(i)) Then
            errorSheet.Cells(x, 4).Value = sourceRange(i)
            errorSheet.Cells(x, 5).Value = _
            Find_First("B:B", wSheet_IBG, wSheet_CS.Cells(i, 1))
            x = x + 1
        End If
    Next
    
    Set topCel = Nothing
    Set bottomCel = Nothing
    Set sourceRange = Nothing
    x = 1
    
    Set topCel = wSheet_CS.Range("J1")
    Set bottomCel = wSheet_CS.Range("J" & wSheet_IBG.UsedRange.Rows.Count)
    If topCel.Row > bottomCel.Row Then End
    Set sourceRange = wSheet_CS.Range(topCel, bottomCel)
     
    numofRows = sourceRange.Rows.Count
  
    For i = 1 To numofRows
        If Application.IsNumber(sourceRange(i)) Then
            errorSheet.Cells(x, 6).Value = sourceRange(i)
            errorSheet.Cells(x, 7).Value = _
            Find_First("B:B", wSheet_IBG, wSheet_CS.Cells(i, 1))
            x = x + 1
        End If
    Next
    
    Set topCel = Nothing
    Set bottomCel = Nothing
    Set sourceRange = Nothing
    x = 1

It's literally a copy/paste change a letter. Way I thought of structuring this and to make it a bit maintain friendly was to create a function and then an array to hold the column references I want to pass to it along with the other values if needed. Of course this is just my first go at it and proof of process functionality. I plan to work on a finished script tomorrow and also add some structure and final documentation/commenting to it.

One thing I failed to post and wish I had was I had a hard time validating a number formatted as currency in my loop to get only the values I wanted. I ended up using the Format to return the string and a InStr for "$#,##0,00" That seems a bit odd to me but it worked of course. I'll post that little validating portion tomorrow if not later on tonight. Hvae to fire up the other laptop to grab it

Thanks


____________ signature below ______________
General FAQ faq333-2924
5 steps to asking a question faq333-3811

 

[HughLerwill]

onpnt,

The following is still not pretty and will run no faster but it is much shorter.

It appears you are using 5 alternate columns starting at F ending with N

Dim topCel As Range
Dim bottomCel As Range
Dim sourceRange As Range
Dim targetRange As Range
Dim x As Integer
Dim i As Integer
Dim numofRows As Integer

For j = Asc("F") to Asc("N") step 2

x = 1

Set topCel = wSheet_CS.Range(chr$(j) & "1")
Set bottomCel = wSheet_CS.Range(chr$(j) & wSheet_IBG.UsedRange.Rows.Count)

If topCel.Row > bottomCel.Row Then End
Set sourceRange = wSheet_CS.Range(topCel, bottomCel)

numofRows = sourceRange.Rows.Count

For i = 1 To numofRows
If Application.IsNumber(sourceRange(i)) Then
errorSheet.Cells(x, 4).Value = sourceRange(i)
errorSheet.Cells(x, 5).Value = _
Find_First("B:B", wSheet_IBG, wSheet_CS.Cells(i, 1))
x = x + 1
End If
Next
'suspect next three lines can be moved to follow Next j - try that
Set topCel = Nothing
Set bottomCel = Nothing
Set sourceRange = Nothing

Next j


regards Hugh

 

[onpnt]

Thanks Hugh, I'll give it shot in the morning when I'm back in the office. I appreciate all your input and guidance on this foreign plan for me in VBA land


____________ signature below ______________
General FAQ faq333-2924
5 steps to asking a question faq333-3811

 

[Tarwn]

Basically your looping through a workbook's sheets looking for column B to be a numeric value. You then grab the value for column A and look for a corresponding value in your original workbook/sheet. once you find a match you then copy the B value you found earlier into this workbook.
So your pulling all of the numeric values from workbook 2 into workbook one.
How many rows are we talking about?
If it's not to many, why not use something like a Dictionary object.
Loop one time through your second workbook looking for numeric values in the B column. if you find one, drop it in a dictionary object with the material code (A column) as the key.
Loop one time through your first workbook, checking each A column material code to see if it's in the dictionary. If it is, set the B column value.

You are adding a dictionary object to the mix, which might slow it down, but your reducing the number of scans your doing to 2. My only concern would be how many values your importing and how the dictionary object reacts to having a large number of values (not sure if it is a proper hashtable).

-T