VBA laten kijken naar juiste cel

[SmitLC]

Beste helpers,

Ik hoop dat iemand mij kan helpen en dat ik het duidelijk genoeg verwoord.

Ik heb van deze geweldige site een macro gekopieerd waarmee ik achternamen uit een lijst kan splitsen naar meerder cellen, nu werkt deze prima zolang de invoer in kolom A staat, echter staan in mijn bestand de bewuste gegevens in kolom J.

Ik heb al geprobeerd om achter range de A te veranderen in J maar dit hielp helaas niets, zou het kunnen dat er elders in de macro nog een verwijzing staat waar ik overheen kijk?

Sub AchternamenSplitsen()
'
' AchternamenSplitsen Macro
'
' Sneltoets: CTRL+SHIFT+M
'
Dim X As Integer, Y As Integer, RijTeller As Long, Spatie(10) As Integer, c As Range
Dim Voorvoegsel As String, Achternaam As String, Naam As String, Voornaam As String

Voorvoeg = MsgBox("Wilt u de voorvoegsels in een aparte kolom?", vbYesNo)
    If Voorvoeg = vbNo Then
        StopZoek = MsgBox("Wilt u de voorvoegsels (van der, v/d) naar de kolom van de achternamen meekopiëren?", vbYesNo)
    End If

For Each c In Range("A1", Range("A1").Range("A" & Rows.Count).End(xlUp))
    
    Naam = Replace(Trim(c.Value), "  ", " ")
    Y = 0
    Spatie(1) = 0
    For X = 1 To Len(Naam) ' Zoeken naar eerste spatie
        If Mid(Naam, X, 1) = " " Then
            Y = Y + 1
            Spatie(Y) = X
            If StopZoek = vbYes Then Exit For ' Voorvoegsels bij Achternaam.
        End If
    Next
    
    If Spatie(1) <> 0 Then ' Spatie gevonden
        If Voorvoeg = vbNo Then
            If StopZoek = vbYes Then Y = 1
            Voornaam = Mid(Naam, 1, Spatie(Y) - 1)
            c = Voornaam
            Achternaam = Mid(Naam, Spatie(Y) + 1)
            c.Offset(, 1) = Achternaam
        Else ' Voorvoegsels apart naar kolom C
            Voornaam = Mid(Naam, 1, Spatie(1) - 1)
            c = Voornaam
            Achternaam = Mid(Naam, Spatie(Y) + 1)
            c.Offset(, 1) = Achternaam
            If Y > 1 Then
                Voorvoegsel = Mid(Naam, Spatie(1), Spatie(Y) - Spatie(1) + 1)
                c.Offset(, 2) = Trim(Voorvoegsel)
            End If
        End If
    Else ' Naam naar kolom K
        c = Naam
    End If
Next
End Sub

 

[Ginger]

In plaats van..

For Each c In Range("A1", Range("A1").Range("A" & Rows.Count).End(xlUp))

Zou ik zeggen...

For Each c In Range("J1", Range("J1").Range("J" & Rows.Count).End(xlUp))

 

[SmitLC]

In plaats van..

For Each c In Range("A1", Range("A1").Range("A" & Rows.Count).End(xlUp))

Zou ik zeggen...

For Each c In Range("J1", Range("J1").Range("J" & Rows.Count).End(xlUp))

Dat heb ik dus al geprobeerd maar werkt helaas niet, zou het kunnen komen doordat er in de kolommen erna (dus K,L,M enz.) ook nog invoer staat?

 

[HSV]

Probeer dit eens.

For Each c In Range("J1", Range("J" & Rows.Count).End(xlUp).Address)

 

[SmitLC]

Probeer dit eens.

For Each c In Range("J1", Range("J" & Rows.Count).End(xlUp).Address)

Helaas hetzelfde resultaat, tot zover wel allemaal bedankt voor het meedenken.

 

[HSV]

Even getest en werkt hier overigens prima.

 

[SmitLC]

Even getest en werkt hier overigens prima.

Ben bang dat het komt doordat ik de informatie invoer via een html koppeling naar een lokaal html bestand, het programma waar de originele lijst uitkomt kan alleen exporteren naar html.
Ik had dus in plaats van de html te openen met excel er een koppeling ingezet, dit zodat mijn collega's het ook makkelijke kunnen gaan gebruiken, maar ik krijg het idee dat daarop de macro niet werkt.
Of er moet iemand nog een ander idee hebben.
Zodra ik de html open in excel, de macro invoer en dan opslaan als .xlsm bestand dan werkt het inderdaad prima.

 

[SmitLC]

En als ik dan toch bezig ben hoop ik zo vervelend te mogen zijn of het ook mogelijk is om dmv dezelfde macro twee kolommen in te laten voegen achter kolom J, zodat daar de verdeelde namen naartoe kunnen.

 

[HSV]

Is niet vervelend hoor.

Voeg de blauwe coderegels toe.

cl declareren als range.

For Each c In Range("J1", Range("J" & Rows.Count).End(xlUp).Address)
[COLOR=#0000ff] if cl is nothing then[/COLOR]
[COLOR=#0000ff]     set cl = c[/COLOR]
[COLOR=#0000ff]     cl.offset(,1).resize(,2).entirecolumn.insert[/COLOR]
[COLOR=#0000ff] end If[/COLOR]
 Naam = Replace(Trim(c.Value), "  ", " ")

 

[SmitLC]

Is niet vervelend hoor.

Voeg de blauwe coderegels toe.

cl declareren als range.

For Each c In Range("J1", Range("J" & Rows.Count).End(xlUp).Address)
[COLOR=#0000ff] if cl is nothing then[/COLOR]
[COLOR=#0000ff]     set cl = c[/COLOR]
[COLOR=#0000ff]     cl.offset(,1).resize(,2).entirecolumn.insert[/COLOR]
[COLOR=#0000ff] end If[/COLOR]
 Naam = Replace(Trim(c.Value), "  ", " ")

Ik krijg de melding "Object vereist"

 

[HSV]

Zoals ik al schreef.

cl declareren als range.

Dim cl as range

Gebruik svp de reageerknop ipv de quote.

 

[SmitLC]

Geweldig HSV het werkt op deze manier, ik ben nog een grote noob met VB maar ik begin het langzaamaan te begrijpen op deze manier, nog een lange weg te gaan denk, ik ga nu proberen om hetzelfde trucje toe te passen op de kolom met voornamen want daar staan er ook meer in, en uiteindelijk is het de bedoeling om van al deze namen de eerste letter in een kolom te krijgen, de zogeheten initialen, dat dacht ik te gaan doen door binnen excel het uiteindelijke werkblad wat we gaan gebruiken te gaan laten kijken naar het infoblad wat ik nu aan het creëren ben en dan daar de formule te gebruiken om uit elke cel alleen de eerste letter over te nemen, misschien is daar ook nog wel een andere optie voor maar op deze manier is het voor mij nog te bevatten.