0

I'm building a template that gets all needed input from an excel file that is selected by the user.

These excel files that the user selects generally have the same layout, however the data cannot be found on the exact same spot and each file contains random column merges, which makes it impossible to hard code the locations of the needed data. So I did create some loops, but these also do not work 100%.

To give you an example I have this user inputted excel file:

enter image description here

From this I need to retrieve the name of all card holders. I have written the following code to load these names into my template. It looks for the word "Naam" in a range in row 4 and then offsets this to get the names.

 Sub KlantInformatie(wsTemplate, wsKlantprofiel)
    Dim i, j As Range
    
    'Inladen accountnummer
    wsTemplate.Range("antAccountnummer").Value = wsKlantprofiel.Range("B2").Value
    
    'Zoeken en inladen van namen CH en ECH's
    For Each i In wsKlantprofiel.Range("C4:K4").Cells
    If i.Value = "Naam" Then
        With wsTemplate
            .Range("antNaamCH") = i.Offset(, 1).Value
            .Range("antNaamECH1") = i.Offset(, 6).Value
            .Range("antNaamECH2") = i.Offset(, 10).Value
            .Range("antNaamECH3") = i.Offset(, 11).Value
            .Range("antNaamECH4") = i.Offset(, 12).Value
            .Range("antNaamECH5") = i.Offset(, 13).Value
            .Range("antNaamECH6") = i.Offset(, 14).Value
            .Range("antNaamECH7") = i.Offset(, 15).Value
            .Range("antNaamECH8") = i.Offset(, 16).Value
            .Range("antNaamECH9") = i.Offset(, 17).Value
            .Range("antNaamECH10") = i.Offset(, 18).Value
        End With
    End If
Next i

However these offsets are not always correct because the data could be in a different column. So what I think I need is a code that offsets to the next non empty value. But I'm not sure how to do that.

FunThomas
  • 23,043
  • 3
  • 18
  • 34

2 Answers2

0

You have a range called searchpos that starts at Naam and then moves to the right. The function nextCHvalue drives it to the right and returns the next available value it finds. It stops moving once it reaches the end of the used range, when intersect returns Nothing.

Note that there is no checking of the header, for example checking that cardhouder is part of the header cell.

Sub KlantInformatie(wsTemplate, wsKlantprofiel)
    Dim i, searchpos As Range
    
    'Inladen accountnummer
    wsTemplate.Range("antAccountnummer").Value = wsKlantprofiel.Range("B2").Value
    
    'Zoeken en inladen van namen CH en ECH's
    For Each i In wsKlantprofiel.Range("C4:K4").Cells

    If i.Value = "Naam" Then
        With wsTemplate
            Set searchpos = i
            .Range("antNaamCH") = nextCHvalue(searchpos)
            .Range("antNaamCH") = nextCHvalue(searchpos)
            .Range("antNaamECH1") = nextCHvalue(searchpos)
            .Range("antNaamECH2") = nextCHvalue(searchpos)
            .Range("antNaamECH3") = nextCHvalue(searchpos)
            .Range("antNaamECH4") = nextCHvalue(searchpos)
            .Range("antNaamECH5") = nextCHvalue(searchpos)
            .Range("antNaamECH6") = nextCHvalue(searchpos)
            .Range("antNaamECH7") = nextCHvalue(searchpos)
            .Range("antNaamECH8") = nextCHvalue(searchpos)
            .Range("antNaamECH9") = nextCHvalue(searchpos)
            .Range("antNaamECH10") = nextCHvalue(searchpos)
        End With
    End If
Next i
End Sub

Function nextCHvalue(ByRef searchpos As Range)
    Do
        Set searchpos = searchpos.offset(, 1)
    Loop While IsEmpty(searchpos) And Not Intersect(searchpos, searchpos.Worksheet.UsedRange) Is Nothing
    nextCHvalue = searchpos.Value
End Function
leosch
  • 451
  • 2
  • 10
0

I changed my code so it looks for the headers instead and then offsets these cells. Works much better:

    Sub KlantInformatie(wsTemplate, wsKlantprofiel)
    Dim i, j As Long
    Dim lCountECH As Long
    Dim wbSource As Workbook
    
    With wsKlantprofiel
     
    'Inladen accountnummer
    wsTemplate.Range("antAccountnummer").Value = wsKlantprofiel.Range("B2").Value
    
        'Vullen data hoofdcardhouder
            For i = 3 To 31
                If Cells(2, i).Value = "1. Hoofdcardhouder" Then
                    wsTemplate.Range("antNaamCH") = .Cells(2, i).Offset(2).Value 'naam
                    wsTemplate.Range("antGebDatumCH") = .Cells(2, i).Offset(5).Value 'geboortedatum
                End If
            Next i
            
        
        'tel aantal ECH
        lCountECH = Application.WorksheetFunction.CountIf(Range("D2:AE2"), "2. Extra-cardhouder")
        
        wsTemplate.Range("antAantalECH").Value = lCountECH
        
        'Data per ECH
        For i = 1 To lCountECH
            For j = 4 To 31
                If .Cells(2, j).Value = "2. Extra-cardhouder" Then
                    wsTemplate.Range("antNaamECH" & CStr(i)) = .Cells(2, j).Offset(2).Value 'vullen namen ECH
                    wsTemplate.Range("antGebDatumECH" & CStr(i)) = .Cells(2, j).Offset(5).Value 'vullen geboortedatum ECH
                    i = i + 1
                End If
            Next j
        Next i
        
    End With
End Sub