Melding voorzien indien LKxxx niet in lijst voorkomt

[danny147]

Beste Ginger,

Nog steeds een foutmelding

Sub hsv()
Dim arr, arr2, sn, i As Long, ii As Long, j As Long, x As Long, n As Long, c As Range, c00, c01, c02
Dim twb As Worksheet
Dim lDatum As Long
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.path & "\Output Danny.xlsx"
 'With GetObject(ThisWorkbook.path & "\Output Danny.xlsx")
 With ActiveWorkbook
  For i = 1 To 3
  arr = Split(ThisWorkbook.Sheets(i).Name, "_")
   With Workbooks("Output Danny.xlsx").Sheets("Rawdata")
    With .Cells(1).CurrentRegion
     
     For x = 0 To 1
     If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False

Set twb = ThisWorkbook.Sheets(i)
       [COLOR="#FF0000"]lDatum = DateValue(DateSerial(Split(twb.[c1], "-")(2), Split(twb.[c1], "-")(1), Split(twb.[c1], "-")(0)))[/COLOR]
       .AutoFilter Field:=1, Criteria1:=">=" & lDatum, Operator:=xlAnd, Criteria2:="<" & lDatum + 1
         Select Case x
            Case 0

Grts Danny147

 

[HSV]

Is het misschien opgemaakt met een slash (dd/mm/yyyy)?

 

[rebmog]

Ik heb de discussie verder niet gevolgd en de codes niet getest, maar in de laatste code valt me op dat lDatum wordt gedeclareerd als Long, terwijl de functie DateValue een Date retourneert. Dus je kunt eens testen met Dim lDatum as Date of door het stuk met DateValue te veranderen in een long. Dus lDatum = CLng(DateValue .......)

 

[danny147]

Beste Ginger en HSV,

Het is gelukt :thumb: :thumb: :d

Door de bijdrage van Ginger en de wijziging van HSV om "/" te gebruiken i.p.v. "-"
1 foutje gevonden bij het volgende, moest 13 zijn i.p.v. 14.

arr2(n, [COLOR="#FF0000"]13[/COLOR]) = sn(ii, 8)

Nu kunnen we verder met de volgende stap, indien iedereen er nog zin voor heeft

Ik zie ook dat de code is geschreven voor alle 3 de tabbladen in één keer in te vullen, dit zou ik liever individueel willen zien

In kolom O komt een groen driehoekje te staan als kolom H begint met RE
of
een blauw bolletje als kolom H begint met RM
Deze symbolen staan op tabblad systeem in cel A1 en A2

In kolom P komt een gegeven validatie te staan als er in kolom H het volgende staat:

RE-1 --> =RE_1
RM-1 --> = RM_1
RE-2 --> = RE_2
RM-2 --> = RM_2
RE-DG --> = RE_1_RE_DG
RM-DG --> = RM_1_RM_DG

In volgende link het bestandje nog eens hoe het er moet uitzien.

http://we.tl/gj60d3xFkL

@rebmog,
Met Date werkt het ook,maar de fout zat bij (dd/mm/yyyy)?

Grts Danny147

 

[snb]

Het lukt mij met deze code:

Sub M_snb()
   With GetObject(ThisWorkbook.path & "\Output Danny.xlsx")
       For Each sh In ThisWorkbook.Sheets
           If InStr(sh.Name, "_") Then
                For j = 0 To 1
                    .Sheets("Blad3").UsedRange.ClearContents
                    .Sheets("Rawdata").ShowAllData
                    
                    With .Sheets("Rawdata").Cells(1).CurrentRegion
                        .AutoFilter 1, format(sh.cells(1,3))
                        .AutoFilter 6, "GT-SP-WKS" & mid("EH",j+1,1) & "-15"
                        .AutoFilter 5, Split(sh.Name, "_"), 7
                        .Copy .Parent.Parent.Sheets("Blad3").Cells(1)
                    End With
                    
                    sn = .Sheets("Blad3").Cells(1).CurrentRegion.Resize(, .Sheets("Blad3").Cells(1).CurrentRegion.Columns.Count + 1)
                    if ubound(sn)>1 then
                      sp = Application.index(sn, Evaluate("row(2:" & UBound(sn) & ")"), Array(3, 9, 10, 41, 41, 41, 41, 41, 5, 13, Application.Match(Format(sh.Cells(1, 3), "dd.mm.yyyy"), Application.index(sn, 1), 0), 2, 41, 41, 8))
                    
                      sh.Cells(28 + j * 10, 1).Resize(UBound(sp), 14) = sp
                    end if
                Next
            End If
        Next
        .Close 0
    End With
End Sub

 

[HSV]

Ik ben nu nieuwsgierig of onderstaande ook werkt uit #50.
Daar stond het met een streepje, nu met een slash.

.AutoFilter 1, CDate(Format(ThisWorkbook.Sheets(i).Cells(1, 3).Value, "dd/mm/yyyy"))

 

[snb]

Ik kwam tot de volgende bevindingen:

Je kunt VBA zelf zijn werk laten doen; daarbij gebruikt het de instellingen van het systeem waarop het draait.
Voeg dus zelf geen opmaakopties toe.

Gebruik dan:

.Autofilter 1, format(sheets(j).cells(1,3))

of

.Autofilter 1, formatdatetime(cdate(sheeets(j).cells(1,3)))

.Autofilter 1, formatdatetime(cdate(sheeets(j).cells(1,3)),2)

Het verbaasde me wel dat datetimeformat niet zelf detecteerde dat cells(1,3) een datum bevatte.

 

[danny147]

Beste HSV en snb,

Code van HSV in post #50 werkte inderdaad met "/"

.AutoFilter 1, CDate(Format(ThisWorkbook.Sheets(i).Cells(1, 3).Value, "dd/mm/yyyy"))

@snb,
Heb uw code laten lopen, maar sommige waarden zijn niet gedefinieerd en bij UBound wordt er een matrix verwacht.
Is dit getest met het laatste bestandje dat ik meegegeven heb ?

Grts Danny147

 

[snb]

Verwijder 'option Explicit'
Heb je de code goed gekopieerd in dezelfde codemodule als waar Sub hsv() staat ?? en als afzonderlijke macro laten lopen?

Ik heb hem laten lopen in de het planningsbestand en outputbestand dat je via wetransfer uploadde.

Ik heb de code nog iets verbeterd voor het geval de filtering geen resultaten oplevert.

 

[danny147]

Beste snb,

Ja en nee

Heb volgende eruit gelaten waarvoor steeds foutmelding: (niet nodig volgens mij)

.Sheets("Blad3").UsedRange.ClearContents
.Sheets("RawData").ShowAllData

Volgende regel heb ik aangepast zodat hij goed zou werken:

sp = Application.index(sn, Evaluate("row(2:" & UBound(sn) & ")"), Array(3, 9, 10, 41, 41, 41, 41, 5, 13, Application.Match(Format(sh.Cells(1, 3), "dd.mm.yyyy"), Application.index(sn, 1), 0), 2, 41, 8))

Wat ik niet zie zijn RM-1, RM-2 en RM-DG, op deze plaats staan ook RE's
RE-1 is goed, RE-2 is goed, RE-DG is gedeeltelijk goed omdat er één RE-2 te veel staat.

Graag code per tabblad en niet alle 3 in één keer

Grts Danny147

 

[danny147]

Beste HSV,

Heb je soms al eens gekeken naar de vragen die ik in post #84 gesteld heb ?

Grts Danny147

 

[snb]

Ik hoop dat in ieder geval anderen iets van mijn code hebben opgestoken.

 

[danny147]

Beste snb,

Ik snap de code een beetje en heb die dan ook aangepast, maar voor RM raak ik hier niet wijs uit.
Kan jij daar nog eens na kijken ?

Grts Danny147

 

[HSV]

Ik ben t/m het pijltje en het rondje.
De gegevensvalidatie moet je nog maar eens uitleggen.
De code is geschreven voor activesheet en kon derhalve met bijna de helft ingekort worden.
Het aardig wil dat de format dd/mm/yyyy ook in mijn bestand goed functioneert.

Test het maar eens.

 

[danny147]

Beste HSV,

Prima, maar je geloofd het niet had foutmelding op volgende rij:

twb.Range("A" & IIf(x = 0, 28, 38)).Resize(n, 15) = arr2

Heb gekeken in output en hij filterde niet, dan maar de code van snb in verwerkt en het lukte dan wel:

lDatum = DateValue(DateSerial(Split(twb.[c1], "/")(2), Split(twb.[c1], "/")(1), Split(twb.[c1], "/")(0)))
.AutoFilter Field:=1, Criteria1:=">=" & lDatum, Operator:=xlAnd, Criteria2:="<" & lDatum + 1

Wat betreft de gegevensvalidatie:

Men kijkt in kolom H wat er staat, ziet men hier RE-1 staan dan wordt de gegevensvalidatie in kolom P =RE_1
zie hier de lijst

RE-1 --> =RE_1
RM-1 --> = RM_1
RE-2 --> = RE_2
RM-2 --> = RM_2
RE-DG --> = RE_1_RE_DG
RM-DG --> = RM_1_RM_DG

Deze kan men terug vinden bij namen beheren.



Grts Danny147

 

[HSV]

Eerst schrijf je dat het filtert met:

.AutoFilter 1, CDate(Format(twb.Cells(1, 3).Value, "dd/mm/yyyy"))

Vervolgens gaat dat goed.
In het laatst geplaatst bestand krijg ik nergens een foutmelding en worden de gegevens opgehaald.
Onbegrijpelijk, ben er nu ook wel een beetje klaar mee.

 

[danny147]

Beste hsv,

Ik weet ook niet waarom ik die foutmelding kreeg op bovenvermelde rij.
En inderdaad, het werkte perfect in vorige code en nu ...
Zolang het maar werkt is alles OK
Ik ga het nog eens nakijken met je geschreven code.

Ik weet dat dit frustrerend is

Laat de samenwerking daardoor niet verpesten en zoeken naar een goede oplossing :thumb:

Grts Danny147

 

[HSV]

Onderstaande coderegel is helaas niet geschikt voor elk versie.

lDatum = DateValue(DateSerial(Split(twb.[c1], "/")(2), Split(twb.[c1], "/")(1), Split(twb.[c1], "/")(0)))

Hier moet ik weer een "-" plaatsen ipv. "/".

Maakt niet uit, als het werkt bij jou gebruik jij die en zal ik nog eens kijken naar de validaties.
Kan je die vooraf niet plaatsen/

 

[danny147]

Beste HSV,

Deze code werkt wel, enkel op mijn werk
Had deze toegepast maandag om 11:15
Op mijn werk hebben ze excel 2007 en thuis heb ik 2010, zit daar het verschil dan ?

.AutoFilter 1, CDate(Format(twb.Cells(1, 3).Value, "dd/mm/yyyy"))

Volgende code werkt enkel met RE-1 en zou moeten aangepast worden om op alle tabbladen te doen werken
ipv te zoeken op RE-1, zoeken naar RE, dan is deze voor alle tabbladen geldig.

arr2(n, 15) = IIf(arr2(n, 8) = "RE-1", ThisWorkbook.Sheets("systeem").Cells(1, 1).Value, ThisWorkbook.Sheets("systeem").Cells(2, 1).Value)

Maakt niet uit, als het werkt bij jou gebruik jij die en zal ik nog eens kijken naar de validaties.
Kan je die vooraf niet plaatsen/

Dit kan ook niet, anders zou het ook maar geldig zijn voor 1 tabblad

Grts. Danny147

 

[danny147]

Beste HSV

1 probleem is al opgelost door deze code te gebruiken:

arr2(n, 15) = IIf(Left(arr2(n, 8), 2) = "RE", ThisWorkbook.Sheets("systeem").Cells(1, 1).Value, ThisWorkbook.Sheets("systeem").Cells(2, 1).Value)

Alleen is de kleur overal blauw en geen groen pijltje.

Grts Danny147