Melding voorzien indien LKxxx niet in lijst voorkomt

danny147 · 27 feb 2016

Beste HSV,

Code in # Post 136 werkt
Code in # Post 138 werkt
de kortere versie werkt niet en heb deze aangepast naar:

Code:

For Each cl In .Range("H" & iRowStart, "H" & iRowEinde)
     If cl <> "" Then
       Select Case cl
          Case Split(mySheetName, "_")(0)
'        cl.Offset(, 8).Validation.Delete
        cl.Offset(, 8).Validation.Add 3, 1, , "=" & Replace(cl, "-", "_")
        cl.Offset(, 7).Font.ColorIndex = IIf(cl = Split(mySheetName, "_")(0), 23, 4)
       End Select
     End If
 Next cl

Deze werkt dan maar hier werkt kleur nr. 4 niet, driehoekje blijft zwart gekleurd.

Code van snb werkt ook niet, krijg volgende fout:
Door de toepassing of door object gedefinieerde fout

Code:

For Each cl In .Range("H" & iRowStart + 1, "H" & iRowEinde)
  If cl <> "" Then
       Select Case cl
          Case Split(mySheetName, "_")(0)
    [COLOR="#FF0000"]cl.Offset(, 8).Validation.Modify 3, 1, , "=" & Replace(cl, "-", "_")[/COLOR]
    cl.Offset(, 7).Font.ColorIndex = IIf(cl = Split(mySheetName, "_")(0), 23, 4)
       End Select
  End If
Next

Grts Danny147

HSV · 27 feb 2016

Wat kan er anders in...

Code:

.Range("H" & iRowStart, "H" & iRowEinde)

...staan dan RE-1 of RM-1 ?

Ik controleer nu alleen maar of de cel niet leeg is natuurlijk en ik weet niet waar die range voor staat (ik maak voor het gemak even een eigen range aan).

danny147 · 27 feb 2016

Beste HSV,

Op tabblad 1 kan niets anders staan dan RE-1 en RM-1.
Het lukt wel in post 136 en 138 ???

Voor mij is post #138 langere versie OK

Groetjes Danny147

HSV · 27 feb 2016

Oké, is ook prima.

danny147 · 28 feb 2016

Beste HSV,

Als er geen gegevens zijn voor LK100 krijg ik foutmelding op volgende regel:

Code:

twb.Range("A1000").End(xlUp).Offset(1).Resize(n, 15) = arr2

Kan je hier een melding insteken:

Code:

MsgBox "Geen opdrachten gevonden voor deze loopkraan """ & str ""

Grts Danny147

HSV · 28 feb 2016

Let er wel op dat je die variabele "str" twee keer gebruikt in de code.

De eerste keer als str = Inputbox, en daarna str = Sheets("Systeem").Range("LK_Row_nummer")

Verander die laatste variabele in een ander naam.

Code:

'twb.Range("A" & iRowStart + 1).Resize(n, 15) = arr2
                
                If n > 0 Then
                   twb.Range("A1000").End(xlUp).Offset(1).Resize(n, 15) = arr2
                   n = 0
                  Erase arr2
                Else
                  MsgBox "Geen opdrachten gevonden voor deze loopkraan """ & str & """"
                End If

danny147 · 28 feb 2016

Beste HSV,

Bedankt voor de opmerking, dit probleem is opgelost.

Ga deze middag wat uitproberen en het laatste komt vanavond of morgen

Grts Danny147

HSV · 28 feb 2016

Ik heb het even verder uitgewerkt voordat je weer andere fouten krijgt en er al gegevens staan terwijl de kraantype geen gegevens heeft.

Test dit bestand even voordat je het bestand vervangt voor je andere.

danny147 · 28 feb 2016

Beste HSV,

Blijkbaar zijn er toch noch problemen met het vinden van de datum.
We beginnen weer met die datum

Met deze code die enkel bij mij thuis werkt, doet hij het niet voor 1/3/2016, er zijn dan wel geen gegevens maar filteren doet die niet op die datum.

Code:

       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

Als ik de code mee volg dan filtert hij alles op 1/2 en 2/2/16

Grts Danny147

HSV · 28 feb 2016

Dan gaan we over op 'Clong' die volgens mij voor elke versie gelijk is.

Code:

.AutoFilter 1, ">=" & CLng(twb.Cells(1, 3)), 1, "<=" & CLng(twb.Cells(1, 3))

Het bestand nog maar eens toegevoegd met nog een kleine aanpassing.

Code:

 For Each cl In .Range("H" & iRowStart[COLOR="#FF0000"] + 1[/COLOR], "H" & iRowEinde)

danny147 · 29 feb 2016

Beste HSV,

Ik probeer volgende regel erbij te voegen om 2 minder rijen te hebben maar loopt niet goed.

Code:

    mySheetName = ActiveSheet.Name
     
    With ThisWorkbook.Sheets("Systeem")
    
        If Sheets(mySheetName).Range("A1000").End(xlUp).Offset(1, 0) = "" Then
        ThisWorkbook.Sheets("Systeem").Range("CHBTRStart") = .Range("CHEinde").Value + 2
        Else: ThisWorkbook.Sheets("Systeem").Range("CHBTRStart") = .Range("CHEinde").Value + 4
        End If
       
        iRowStart = .Range("CHBTRStart")

Kan jij dit even aanpassen.

Grts Danny147

HSV · 29 feb 2016

Als je nog niet tot rij 1000 bent gekomen met je gegevens is deze vergelijking overbodig (deze cel zal altijd leeg zijn).

Code:

If Sheets(mySheetName).Range("A1000").End(xlUp).Offset(1, 0) = "" Then

Trouwens, in welke sub staat die code en wat is de bedoeling.

snb · 29 feb 2016

danny147 zei:
Ik probeer volgende regel erbij te voegen om 2 minder rijen te hebben maar loopt niet goed.

Kan jij dit even aanpassen.

Ik vraag me af deze stijl nog overeenkomt met de bedoeling van een forum als 'helpmij.nl'.
Ik heb niet de indruk dat de TS hier iets van leert of wil leren.

HSV · 29 feb 2016

Dat idee kreeg ik ook al @snb.

We schakelen maar heen en weer en op de vorige vraag krijg ik ook al geen reactie, maar dat zal dan wel weer opgelost zijn denk ik.
Ook vraag ik me af wie al die code heeft geschreven zodat het steeds maar aangepast moet worden (misschien een collega die er niet meer werkt?).

Je zou toch denken dat Danny zich nu zo langzamerhand wel een beetje moet kunnen redden.

danny147 · 29 feb 2016

Beste HSV,

Sorry :shocked:

Gisteren PC niet meer bekeken en pas deze morgend op mijn werk gezien van beide codes die je door gestuurd heb.
Dat met de datum is opgelost en werkt perfect en andere code heb ik aangepast.

Wat betreft in # Post 151, dit stukje code wil ik plaatsen aan het begin van Sub vervolg()
Indien er geen gegevens zijn voor sjabloon "Columnheader", dan start sjabloon "ColumnheaderBTR" 4 regels daaronder.
Dit wil ik inkorten naar 2.

@snb, natuurlijk wil ik bijleren, al wat niet is geschreven door HSV en jou heb ik zelf gedaan.

HSV · 29 feb 2016

Is dat niet dit stukje waar je de "+2" weg kan halen?

Code:

With ThisWorkbook.Sheets("Systeem")
    
       .Range("CHBTRStart").Value = .Range("CHEinde")[COLOR=#3366ff] [/COLOR][COLOR=#ff0000]+ 2[/COLOR][COLOR=#3366ff][/COLOR]
       
        iRowStart = .Range("CHBTRStart")
        
        .Range("ColumnHeaderBTR").Copy Sheets(mySheetName).Range("A" & iRowStart)

danny147 · 29 feb 2016

Beste HSV,

Inderdaad, kijk wat er gebeurd als je LK101 ipv LK100 intypt.
Er wordt dan wel geen data opgehaald maar dat geeft niet.
Indien er gegevens zijn wordt er netjes een lege regel ingevoegd anders niet.

HSV · 29 feb 2016

Hallo Danny,

Ik heb de code hier en daar wat aangepast, maar je moet maar ergens in het bestand aangeven waar wat niet of wel hoort.

danny147 · 29 feb 2016

Beste HSV,

Onderstaande voor Module "Werk_plek"

Code:

Sub VulAlgemeneZakenIn(control As IRibbonControl)

    mySheetName = ActiveSheet.Name

    Application.ScreenUpdating = False

    Sheets("Systeem").Select
    Range("WPL_ELE_MEC").Select
    Selection.Copy
    Sheets(mySheetName).Select
    Range("A25").Select
    ActiveSheet.Paste
    
    invoeren_gegevens_WPL
    
    opmaak
    
    Application.ScreenUpdating = True
     
    End Sub
Sub invoeren_gegevens_WPL()
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, twb As Worksheet
Dim lDatum As Date
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.path & "\Output Danny.xlsx"
 'With GetObject(ThisWorkbook.path & "\Output Danny.xlsx")
 With ActiveWorkbook
  Set twb = ThisWorkbook.ActiveSheet
  arr = Split(twb.Name, "_")
   With Workbooks("Output Danny.xlsx").Sheets("Rawdata")
    With .Cells(1).CurrentRegion
     'For x = 0 To 1
     If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
     
'       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
'        .AutoFilter 1, CDate(Format(ThisWorkbook.Sheets(i).Cells(1, 3).Value, "dd/mm/yyyy"))
'        .AutoFilter 1, CDate(Format(twb.Cells(1, 3).Value, "mm/dd/yyyy"))
        .AutoFilter 1, ">=" & CLng(twb.Cells(1, 3)), 1, "<=" & CLng(twb.Cells(1, 3))
        .AutoFilter 6, IIf(x = 0, "GT-SP-WKSE-15", "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(twb.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, 13) = sn(ii, 8)
                          arr2(n, 15) = IIf(Left(arr2(n, 8), 2) = "RE", ThisWorkbook.Sheets("systeem").Cells(1, 1).Value, ThisWorkbook.Sheets("systeem").Cells(2, 1).Value)
                        Next j
                        End If
                       Next ii
               
                If n > 0 Then
                   twb.Range("A" & IIf(x = 0, 28, 38)).Resize(n, 15) = arr2
                   n = 0
                  Erase arr2
                End If
       'Next x
    End With
   End With
.Close 0
End With
End Sub
Sub opmaak()

    mySheetName = ActiveSheet.Name
    With ThisWorkbook.Sheets(mySheetName)
    
    Rows("26:33").Rows.Group
    Rows("36:43").Rows.Group
    Rows("25:25").EntireRow.AutoFit
    Rows("35:35").EntireRow.AutoFit
    Rows("26:34").RowHeight = 15
    Rows("36:43").RowHeight = 15
    Range("A28:R32,A38:R42").Font.Name = "Comic Sans MS"
    Range("A45").Select
    
    With ThisWorkbook.Sheets("Systeem")

    iRowEinde = .Range("MECEinde")
    iRowStart = .Range("ELEStart")
    
    With ThisWorkbook.Sheets(mySheetName)
    
    For Each cl In .Range("H" & iRowStart, "H" & iRowEinde)
      If cl <> "" Then
       Select Case cl
          Case Split(mySheetName, "_")(0)
            cl.Offset(, 7).Font.Color = -4165632
'            cl.Offset(, 8).Validation.Delete
            cl.Offset(, 8).Validation.Add 3, 1, , "=" & Replace(cl, "-", "_")
          Case Split(mySheetName, "_")(1)
            cl.Offset(, 7).Font.Color = -13321973
'            cl.Offset(, 8).Validation.Delete
            cl.Offset(, 8).Validation.Add 3, 1, , "=" & Replace(cl, "-", "_")
        End Select
      End If
     Next cl
     
     End With
       End With
         End With

End Sub

Indien je nog select kan wegwerken, geen probleem.
Deze avond geen tijd meer omdat ik bezet ben.

HSV · 29 feb 2016

Moet ik alleen de 'selects' wegwerken?

Dat zou je nu onderhand zelf toch moeten kunnen?

Melding voorzien indien LKxxx niet in lijst voorkomt

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Bijlagen

Terugkerende gebruiker

Inventaris

Bijlagen

Terugkerende gebruiker

Inventaris

Verenigingslid

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Bijlagen

Terugkerende gebruiker

Inventaris

Wij waarderen jouw privacy