Do loop until and For Each next

[MBM2016]

Hi,

I have to import a few excel files into Access for cleanup, I am dealing with 65+ individual files and million+ records. - My goal is to have all my headers in excel standardized so the import process to Access is a lot easier. This macro should be able to run from the personal macro workbook.


I am importing pipe delimited text files from various sources and none of the formatting in the headers match (some providers decided to play around with the entire layout). With this issue at hand, I created an Excel workbook named Reference(aka Map) with the incoming files layout and standardized/corrected columns' name formatting.


The good news for me is, the file ID will always be on column A. I have about 65 files that need to processed each month so I need to minimize all possible steps and therefore need to have the Reference workbook closed.


With this, I looked around online and put together most of the solution to pull in the new headers based on the ID located in A3. Yet a dilemma still exists, sometimes the ID on A3 will not exist on the Reference workbook - I need to have the vlookup move down to the next row until the result does not equal #N/A or 0 or blank.


At this point I got the 'Do Loop Until' to find the correct row for the first match - works perfectly with out any code following it.


As soon as the vlookup finds a row with an existing ID, then run the snippet below to populate the remaining headers. The only side effect of the next step is, for some reason rID offsets +1 row, undoing the 'Do Loop until' if the final row does not contain a matching ID.

'> Populate remaining headers
    For Each cell In rng1
            cell.Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
            i = i + 1
    Next

This is what I have so far:

Sub DAc_lookup_headers()


    Dim wb1 As Workbook 'Current text/file
    Dim map As String 'reference Map
    Dim cID As String 'wb1 look up column A
    Dim rID As String 'wb1 starting row number
    Dim rng1 As Range 'wb1 Collection header range
    Dim i As Long 'Index number per cell in range




    Set wb1 = ActiveWorkbook
    Set rng1 = wb1.ActiveSheet.[A1:G1]


    map = ("'C:\Users\x165422\Desktop\New folder\[Reference.xlsx]Ref'!$A$1:$I$13")


    rID = 3 'Row where ID is - will increment + 1 if not found
    cID = "A" 'Column where ID is
    i = 3 'Starting vlookup Index number - to increment per cell in range


    '>Look for ID until value is found
    Do
        wb1.ActiveSheet.[a1].Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
        rID = rID + 1
    Loop Until wb1.ActiveSheet.[a1].Text <> "#N/A" Or "0"
    
    '> Populate remining headers
    For Each cell In rng1
            cell.Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
            i = i + 1
    Next
    
    '> Convert to values
    With rng1
        .Value = .Value
    End With


    End Sub

 

[AlphaFrog]

Hi and welcome to the forum.

The only side effect of the next step is, for some reason rID offsets +1 row, undoing the 'Do Loop until' if the final row does not contain a matching ID.

Initialize rID = 2 and increment rID = rID + 1 before the VLOOKUP formula.

    [B]rID = 2[/B]    [COLOR=green]'Row where ID is - will increment + 1 if not found[/COLOR]
    cID = "A"    [COLOR=green]'Column where ID is[/COLOR]
    i = 3    [COLOR=green]'Starting vlookup Index number - to increment per cell in range[/COLOR]
    
    [COLOR=green]'>Look for ID until value is found[/COLOR]
    [COLOR=darkblue]Do[/COLOR]
[B]        rID = rID + 1
        wb1.ActiveSheet.[a1].Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")[/B]
    [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]Until[/COLOR] wb1.ActiveSheet.[a1].Text <> "#N/A" [COLOR=darkblue]Or[/COLOR] "0"

 

[MBM2016]

Thank you AlphaFrog, I cannot believe it was that simple. Glad to be part of the forums!

 

[AlphaFrog]

You're welcome and thanks for the feedback.

And well done on using CODE tags in your 1st post. It's appreciated.