• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA, Cel 2 vullen met een gegevensvalidatielijst

Status
Niet open voor verdere reacties.
V

veenvlij

Gebruiker
Lid geworden
4 dec 2008
Berichten
23
Met behulp van VB code wil ik cel 2 van kolom test vullen met een gegevensvalidatie lijst.
Dit omdat kolom test geen vaste kolom is, per aangeleverd bestand op een andere plek kan staan.
tot zover heb ik code gemaakt, probleem is echter dat deze de waarde al in cel 1 zet, niet in 2.
Ook al geprobeerd met Range("H2").Select , maar H is dus een variabele kolom.

heeft iemand een idee ?

Sub FindAddressColumn()
Dim xRg As Range
Dim xRgUni As Range
Dim xFirstAddress As String
Dim xStr As String
On Error Resume Next
xStr = "test"
Set xRg = Range("A1:Z1").Find(xStr, , xlValues, xlWhole, , , True)
If Not xRg Is Nothing Then
xFirstAddress = xRg.Address
Do
Set xRg = Range("A1:Z1").FindNext(xRg)
If xRgUni Is Nothing Then
Set xRgUni = xRg
Else
Set xRgUni = Application.Union(xRgUni, xRg)
End If
Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
End If
xRgUni.EntireColumn.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Blad2!$A:$A"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
 

Bijlagen

  • test -.xlsm
    16,3 KB · Weergaven: 18
alleen rij 2 van de bewuste kolom of de hele kolom?
 
zo misschien?


Code: 
Sub L()

Dim str As String
Dim c As Long
Dim r As Long

str = "test"

c = WorksheetFunction.Match(str, Range("1:1"), 0)
r = 20 'Aantal rijen met data validatie

With Range(Cells(2, c), Cells(2, c).Offset(r, 0))
        .Interior.Color = RGB(188, 188, 188)
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Blad2!$A:$A"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
End With

End Sub


Lambert
 
Hallo Lambert

Top, dit is precies wat ik zoek.

cel 2 vullen is voldoende, trek hem wel door tot laatste rij

Dank je wel
 
trek hem wel door tot laatste rij
Klik om te vergroten...


is de bedoeling van een macro niet dat je zelf juist zo min mogelijk doet...
je kunt met de variabele 'r' het aantal rijen ingeven, tot waar de gegevens validatie doorgetrokken moet worden.
En als dat variabel is, valt dat vast en zeker wel op de één of andere manier te bepalen.
 
Hallo Lambert

het aantal rijen kan varieren per sheet van 100 tot 8000
als er een effectievere manier is dan heel graag

Kolom A is vast, die is bruikbaar voor het aantal rijen
 
Laatst bewerkt:
maar hoe....?
Dat valt dan zonder voorbeeldbestand niet te bepalen
 
Hallo Lambert

Ik heb een test bestand bijgevoegd.
Kolom A is altijd gevuld t/m/ de laatste rij.

Alvast bedankt voor je hulp
 

Bijlagen

  • test -2.xlsm
    14,7 KB · Weergaven: 25
Alstu,

Code: 
Sub L()

Dim str As String
Dim c As Long
Dim r As Long

str = "test"

'--Zoek "test" in rij 1--
If WorksheetFunction.CountIf(Range("1:1"), str) > 0 Then
    c = WorksheetFunction.Match(str, Range("1:1"), 0)
Else
    MsgBox str & " niet gevonden", vbCritical
    Exit Sub
End If


'--Aantal rijen met data validatie--
r = WorksheetFunction.CountA(Range("A:A"))
If r < 2 Then r = 2

'--Gegevens validatie toepassen--
With Range(Cells(2, c), Cells(2, c).Offset(r - 2, 0))
        .Interior.Color = RGB(188, 188, 188)
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Blad2!$A:$A"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
End With

End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan