Check alle échte Black Friday-deals Ook zo moe van nepaanbiedingen? Wij laten alleen échte deals zien
Toon posts:

VBA Range datalist validation

Pagina: 1
Acties:

Verwijderd

Topicstarter
Hallo,

Ik ben in een excel bezig om de prijslijsten van verschillende klanten op te halen. Ik kopieer alle gegevens uit een ander workbook naar een sheet in mijn actieve workbook (technical calculation). Ik zoek in de prijslijsten naar de laatste kolom die gevuld is en probeer zo alle klantnamen op te halen en deze in een Range op te slaan om daarmee dynamisch via VBA een data validation list te vullen.

De code is als volgt:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Dim LastColumnIndex As Integer
    Dim Choices As Range

    Sheets("Tarieven").Visible = False
        
    'Tarieven ophalen uit bestand van het netwerk en kopieren
    Workbooks.Open Filename:="H:\Resource Management\RM Documentation\Templates\Technical Calculation\Tarieven.xls"
    Sheets("Prijs afspraken").Cells.Select
    Selection.Copy
    
    'Tarieven plakken in Sheet 'Tarieven' in calculatie
    Windows("Template Technical Calculation v4.3.xls").Activate
    Sheets("Tarieven").Visible = True
    Sheets("Tarieven").Activate
    ActiveSheet.Cells.Select
    ActiveSheet.Paste
    
    'Klantnamen ophalen uit sheet 'Tarieven' en Range zetten voor Validation List
    Sheets("Tarieven").Activate
    LastColumnIndex = Sheets("Tarieven").Range("B1").End(xlToRight).Column
    Set Choices = Range(Cells(1, 2), Cells(1, LastColumnIndex))
    
    'Data validation list selecteren op sheet 'Hourly Rates' en lijst vullen
    Sheets("Hourly Rates").Activate
    Range("C1").Select
    
        With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Choices
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
        End With

    'Excel Tarieven sluiten
    Windows("Tarieven.xls").Activate
    ActiveWindow.Close
    
    Sheets("Tarieven").Visible = False
    Sheets("Hourly Rates").Select
    
ErrHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
     
End Sub


Het probleem zit hem in het vullen van de Range "Choices". Deze blijft leeg waarna ik bij het vullen van de Validation List uitkom in de ErrHandler. Kan iemand me hiermee helpen?
Alvast bedankt!

Verwijderd

Volgens de macro-recorder moet de syntax achter het argument Formula1 alsvolgt zijn:

Visual Basic .NET:
1
Formula1:="=$A$1:$A$5"


Je kunt hier dus geen Range-object invullen, maar zult moeten verwijzen naar het adres van die Range.

  • Reptile209
  • Registratie: Juni 2001
  • Laatst online: 02:50

Reptile209

- gers -

Krijgt LastColumnIndex wel de waarde die je verwacht? Gaat het wel goed als je die index als getal invult in de expressie waarmee je de Range voor Choices berekent?

Zo scherp als een voetbal!


Verwijderd

Topicstarter
Nav de comment van Alargule heb ik het aangepast en ontdekte ik tevens dat ik een Named Range moet gebruiken omdat de data uit een andere sheet komt. Maar nou krijg ik het probleem dat de Named Range leeg blijft, terwijl ik de range wel goed terug krijg ("B1:AB1").
Iemand een idee waar dat aan ligt?

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    Sheets("Tarieven").Activate
    LastColumnIndex = Sheets("Tarieven").Range("B1").End(xlToRight).Column
    FirstColumnName = "B1"
    LastColumnName = Cells(1, LastColumnIndex).Address(False, False)
    
    ' Choices = de op te halen range ("B1:AB1")
    Choices = (FirstColumnName + ":" + LastColumnName)
    
    ' Named Range verwijst naar variabele 'Choices' waarin de Range staat
    Names.Add Name:="rngChoices", RefersTo:=Choices
    Sheets("Hourly Rates").Activate
    Range("C1").Select
    
        With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" + rngChoices              --->>>> named range is leeg???!!!
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
        End With

Verwijderd

Verwijderd schreef op maandag 06 juli 2009 @ 14:11:
Nav de comment van Alargule heb ik het aangepast en ontdekte ik tevens dat ik een Named Range moet gebruiken omdat de data uit een andere sheet komt. Maar nou krijg ik het probleem dat de Named Range leeg blijft, terwijl ik de range wel goed terug krijg ("B1:AB1").
Iemand een idee waar dat aan ligt?

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    Sheets("Tarieven").Activate
    LastColumnIndex = Sheets("Tarieven").Range("B1").End(xlToRight).Column
    FirstColumnName = "B1"
    LastColumnName = Cells(1, LastColumnIndex).Address(False, False)
    
    ' Choices = de op te halen range ("B1:AB1")
    Choices = (FirstColumnName + ":" + LastColumnName)
    
    ' Named Range verwijst naar variabele 'Choices' waarin de Range staat
    Names.Add Name:="rngChoices", RefersTo:=Choices
    Sheets("Hourly Rates").Activate
    Range("C1").Select
    
        With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" + rngChoices              --->>>> named range is leeg???!!!
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
        End With
formula1:="=rngChoices". je geeft zelf de reden waarom het zo moet ;)

Verwijderd

Topicstarter
_heretic_ het mag niet baten. Heb het aangepast zoals je aangaf... was idd beetje foutje 8)7
Maar nog steeds als ik met de debugger door de regels heen loop, geeft hij bij het toevoegen van de named range aan de Validation aan, dat deze "Empty" is. Op de een of andere manier vult hij de range "rgnChoices" niet.
Ik heb al van alles geprobeerd, maar kom er niet uit.

[ Voor 9% gewijzigd door Verwijderd op 06-07-2009 14:47 ]


Verwijderd

Ik zou dan eerst eens proberen te achterhalen wat er in je variabele "Lastcolumnname" komt te zitten, zoals al is gesuggereerd. Ook dat moet een celadres zijn.

Verwijderd

Topicstarter
De waarde die ik terugkrijg van LastColumnname = AB1

Verwijderd

Volgens mij moet je bij het opgeven van een named range ook altijd de betreffende sheetnaam vermelden.

Verwijderd

Verwijderd schreef op maandag 06 juli 2009 @ 15:12:
Volgens mij moet je bij het opgeven van een named range ook altijd de betreffende sheetnaam vermelden.
nee, in het argument formule1 komt gewoon de naam die het bereik gekregen heeft. Marsha2711 zit misschien nog met een onjuist bereik in deze naam als gevolg van eerdere pogingen.

Verwijderd

Ik heb het over het argument RefersTo van de Names.Add methode. Daar moet altijd een werkbladnaam bij, en die wordt er in de huidige code (voorzover ik kan zien) niet bijgezet.

Verwijderd

Topicstarter
Ik heb het als volgt:

- String "Choises" wordt gevuld met de waarde: "=B1:AB1"
- Vervolgens maak ik de named Range "rngChoices" met RefersTo:=Choices
- In de data validation list voer ik dan het volgende: formula1:= rgnChoices

Het lijkt allemaal goed te gaan totdat ik bij het vullen van de List uitkom. Dan zie ik dat de waarde van named ranged "Empty" is.....

Verwijderd

Topicstarter
Alargule, ik heb het ook geprobeerd door de in de string 'Choises' de volgende waarde op te nemen: "=Tarieven!B1:AB1", maar ook daarmee krijg ik de melding dat de range leeg is.

Verwijderd

ik stel voor dat je nog eens debugt en daarbij tijdelijk errhanlder uitschakelt en screenupdating & displayalerts inschakelt en nog eens de actuele code post indien je daar nog moeilijkheden mee ondervindt.

onderstaande code is onafhankelijk van de selectie en vervangt regel 25 tem 47
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
  Names.Add _
      Name:="rngChoises", _
      RefersTo:= _
        Range _
          ( _
            Sheets("tarieven").Range("b1"), _
            Sheets("tarieven").Range("b1").End(xlToRight) _
          )
  With Sheets("Hourly Rates").Range("c1").Validation
    .Delete
    .Add _
        Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, _
        Formula1:="=rngChoises"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
  End With

Verwijderd

Topicstarter
Na nog wat googelen gisteravond kwam ik erachter wat er fout ging! Namelijk dat ik een string in een Range probeerde te drukken, dat schijnt dus niet te kunnen en daardoor bleef de range leeg! Dus aangepast en het werkt als een tiet ;)

Bedankt voor het meedenken en de hulp!

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Dim LastColumnIndex As Integer
    Dim FirstolumnName As String
    Dim LastColumnName As String
    
    Sheets("Tarieven").Visible = False
        
    'Tarieven ophalen uit bestand van het netwerk
    Workbooks.Open Filename:="H:\Resource Management\RM Documentation\Templates\Technical Calculation\Tarieven.xls"
    Sheets("Prijs afspraken").Cells.Select
    Selection.Copy
    
    'Tarieven kopieren naar calculatie
    Windows("Template Technical Calculation v4.3.xls").Activate
    Sheets("Tarieven").Visible = True
    Sheets("Tarieven").Activate
    ActiveSheet.Cells.Select
    ActiveSheet.Paste
    
    Sheets("Tarieven").Activate
    LastColumnIndex = Sheets("Tarieven").Range("B1").End(xlToRight).Column
    FirstColumnName = "B1"
    LastColumnName = Cells(1, LastColumnIndex).Address(False, False)
    Names.Add Name:="rngChoices", RefersTo:=Sheets("Tarieven").Range(FirstColumnName + ":" + LastColumnName)
    
        With Sheets("Hourly Rates").Range("c1").Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=rngChoices"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
        End With

    'Excel Tarieven sluiten
    Windows("Tarieven.xls").Activate
    ActiveWindow.Close
    
    Sheets("Tarieven").Visible = False
    Sheets("Hourly Rates").Select
    
ErrHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
     
End Sub
Pagina: 1