• 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.

Melding voorzien indien LKxxx niet in lijst voorkomt

Status
Niet open voor verdere reacties.
Hallo Danny,

Lijkt dit op je wensen?
Dankzij @Warme bakkertje het wachtwoord d.m.v. een Vba-code verwijderd.
Code: 
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
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
       .AutoFilter 1, CDate(ThisWorkbook.Sheets(i).Cells(1, 3).Value)
         Select Case x
            Case 0
                     .AutoFilter 6, "GT-SP-WKSE-15"
                     .AutoFilter 5, arr(0), 2, arr(1)
                    
                   sn = .Cells(1).CurrentRegion
                     ReDim arr2(1 To UBound(sn), 1 To UBound(sn, 2))
                       For ii = 2 To UBound(sn)
                        If Not .Rows(ii).Hidden Then
                           n = n + 1
                         For j = 1 To UBound(sn, 2)
                          arr2(n, 1) = sn(ii, 3)
                          arr2(n, 2) = sn(ii, 9)
                          arr2(n, 3) = sn(ii, 10)
                          arr2(n, 8) = sn(ii, 5)
                          arr2(n, 9) = sn(ii, 13)
                          c00 = Application.Index(sn, 1, 0)
                          c01 = Replace(Format(ThisWorkbook.Sheets(i).Cells(1, 3), "dd-mm-yyyy"), "-", ".")
                          c02 = Application.Match(c01, c00, 0)
                          If Not IsError(c02) Then arr2(n, 10) = sn(ii, c02)
                          arr2(n, 11) = sn(ii, 2)
                          arr2(n, 14) = sn(ii, 8)
                        Next j
                        End If
                       Next ii
                ThisWorkbook.Sheets(i).Range("A28").Resize(n, 14) = arr2
                n = 0
                Erase arr2
            Case 1
                   .AutoFilter 6, "GT-SP-WKSM-15"
                   .AutoFilter 5, arr(0), 2, arr(1)
                   sn = .Cells(1).CurrentRegion
                     ReDim arr2(1 To UBound(sn), 1 To UBound(sn, 2))
                       For ii = 2 To UBound(sn)
                        If Not .Rows(ii).Hidden Then
                          n = n + 1
                         For j = 1 To UBound(sn, 2)
                          arr2(n, 1) = sn(ii, 3)
                          arr2(n, 2) = sn(ii, 9)
                          arr2(n, 3) = sn(ii, 10)
                          arr2(n, 8) = sn(ii, 5)
                          arr2(n, 9) = sn(ii, 13)
                          c00 = Application.Index(sn, 1, 0)
                          c01 = Replace(Format(ThisWorkbook.Sheets(i).Cells(1, 3), "dd-mm-yyyy"), "-", ".")
                          c02 = Application.Match(c01, c00, 0)
                          If Not IsError(c02) Then arr2(n, 10) = sn(ii, c02)
                          arr2(n, 11) = sn(ii, 2)
                          arr2(n, 14) = sn(ii, 8)
                        Next j
                        End If
                       Next ii
                ThisWorkbook.Sheets(i).Range("A38").Resize(n, 14) = arr2
                n = 0
                Erase arr2
          End Select
       Next x
    End With
   End With
Next i
.Close 0
End With
End Sub
 
Laatst bewerkt:
Beste HSV,

Krijg volgende foutmelding.

Foutmelding.JPG

Grts Danny147
 
Daar had ik dus het wachtwoord voor nodig. ;)
 
Beste HSV,

Deze weet ik ook niet :confused:

Grts Danny147
 
Ik zal het bestand plaatsen waarin het wachtwoord is verwijderd.
Misschien werkt deze nog voor je.
Code staat in module 1.
 

Bijlagen

Beste HSV,

Stukje bij stukje komen we er wel,
Nu foutmelding op het volgende:

Foutmelding.JPG

Tabblad van "Output Danny.xlsx" staat open maar geen gegevens te zien na het filteren ?

Grts Danny147
 
Beste HSV,

Als ik kijk naar de filter op tabblad RawData in kolom A zie ik het volgende:

Foutmelding2.JPG

Hij filtert op 2/1/2016 ipv 1/2/2016 in mijn versie.

Grts Danny147
 
Als je de code doorloopt met F8 zie je dat het ander bestand open gaat en zie je de filter in kolom A staan op 1-2-2016.
Niets mis mee dus.
Hier stond al:
Code: 
.AutoFilter 1, CDate(ThisWorkbook.Sheets(i).Cells(1, 3).Value)
 
Beste HSV,

Bij mij staat deze op 2/1/2016 :confused:

Grts Danny147
 
Probeer anders:
Code: 
 .AutoFilter 1, CDate(Format(ThisWorkbook.Sheets(i).Cells(1, 3).Value, "dd-mm-yyyy"))
 
Beste HSV,

Heb code laten lopen en gestopt na de filter, dan gekeken en volgende resultaat:

Foutmelding2.JPG

Gevonden op het internet, kan je deze gebruiken in de code ?

Code: 
Dim sDatum As String
Dim dag, maand, jaar
        dag = Right("0" & CStr(Day(dDatum)), 2)
        maand = Right("0" & CStr(Month(dDatum)), 2)
        jaar = Right("00" & CStr(Year(dDatum)), 4)
        
        sDatum = dag & "." & maand & "." & jaar

Grts danny147
 
Geen idee of dat werkt.
Vreemde zaak.
Probeer je het wel met het bestand wat ik geplaatst heb?
Staat er in cel C1 wel 1-2-2016?
 
Laatst bewerkt:
Gebruik de functie Dateserial om datums aan het workbook terug te geven...
 
Beste HSV,

Zal alles eens overschrijven in een nieuw bestandje en de link hier posten.

@Ginger,
Waar en hoe ??

Grts Danny147 :thumb:
 
Hallo Danny,

Wat Leo bedoelt.

Code: 
dim twb as worksheet
Set twb = ThisWorkbook.Sheets(i)
       .AutoFilter 1, DateSerial(Year(twb.[c1]), Month(twb.[c1]), Day(twb.[c1]))
 
@Danny, De interactie van VBA met het Workbook is in de taal waarin het ontwikkeld is. Ofwel, Engels (Amerikaans). Omdat de interpreter van VBA de waarde die je teruggeeft "beoordeelt", zal deze er éérst een Engels-datum-format van proberen te maken. Bij een datum waar de dag onder de 13 ligt, heeft het systeem dus problemen. Twee januari zal dan gezien worden als 1 februari en zo worden teruggegeven. Door de functie DateSerial te gebruiken, geef je ondubbelzinning aan VBA aan wat precies de dag en precies de maand is. Zo kan je dus nooit die genoemde verwisseling krijgen.

En "Leve HSV"... Hij past dit uiteraard al weer gelijk netjes in jouw code toe. ;)
 
Met jouw idee heb je uiteraard een stabiele code waarvoor dank Leo.
Toch blijft het een raadsel waarom het bij Danny niet lukt in de door hem geplaatste bestanden en hier wel.
Misschien is er nog een addertje onder het gras die Danny nog niet heeft toegelicht.
 
Beste HSV,

Het is een raadsel want met DateSerial werkt het ook niet.
Vanavond post ik het nieuw bestandje

Waarschijnlijk ligt het aan het Output bestandje ??? want datum blijft 2/1/2016 ipv 1/2/2016 na het filteren.

Kan men niet werken met:
Dag(links(C1;2)
Maand(deel(C1;3;2)
Jaar(rechts(C1;4)

Grts Danny147
 
Laatst bewerkt:
Nee, dat is geen goed idee.

Dat zou voor sommige kunnen werken en anderen weer niet.
Als het een Nederlands datumformaat heeft gaat het waarschijnlijk goed.
Bij een Amerikaans formaat natuurlijk weer niet.
Als dit al niet werkt is er vast iets anders met het bestand 'Output' aan de hand.

We wachten je nieuw geplaatst wel af.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan