Trelkrok Skrevet 3. august 2016 Del Skrevet 3. august 2016 Hei igjen. Har ett ønske om å automatisere Pakkseddel programmet mitt enda mere men trenger da hjelp til dette hvis noen vil gjøre det. Skal prøve å forklare hva jeg ønsker. I fanen «Bestillingsliste ved» fører jeg opp bestillinger fra kunder. 1.Jeg setter inn kundens navn i kolonne B3 og nedover. Gate, Poststed, Mobil og Epost kommer da fra Kunderegister av seg selv. 2. I kolonne J3:N3 og nedover settes det inn antall av hva det er kunden bestiller 3. Når en kunde i bestillingslisten er fakturert settes det X i kolonne P og valgt rad blir Grønn, som betyr at det er fakturert. Så til det jeg ønsker: Når jeg setter x i kolonne P på den kunden jeg skal fakturere i Bestillingslisten ønsker jeg at det skal komme opp en boks «Vil du opprette Pakkseddel på denne kunden» JA NEI Når det da klikkes JA vil jeg at kundens Navn på valgt rad i Bestillingsliste skal komme i B10 på Pakkseddel. Varebeskrivelsen som står i J2:N2 i Bestillingsliste ved skal komme opp i C18:C34 i Pakkseddel og antall i kolonne D18:D34 på Pakkseddel Jeg har lagt ved bilder som viser at det er opprettet pakkseddel på Kunde 2. Og aktuelle linje i Bestillingsliste ved er grønn (x i P4) Som det kommer fram av Bestillingslisten er det ikke opprettet Pakkseddel på Kunde 1 og Kunde 2 Håper dette forklarer hva jeg ønsker og håper noen kan hjelpe meg med dette. Mvh RA Lenke til kommentar
Harald Staff Skrevet 4. august 2016 Del Skrevet 4. august 2016 Hei igjen Når det gjelder x bruker du worksheet_change-eventet som vi har snakket om før. Boksen ordner du slik: If MsgBox("Sikker på detta?", vbYesNo, "Pakkseddel?") = vbNo then Exit Sub Resten kommer du i gang med ved å spille inn makroer mens du gjør det manuelt håper jeg. Beste hilsen Harald Lenke til kommentar
Trelkrok Skrevet 6. august 2016 Forfatter Del Skrevet 6. august 2016 Hei og TAKK for svar Tror jeg gir opp dette, ble for mye for en Trelkrok Tar gjerne imot tips / hjelp med dette. Mvh RA Lenke til kommentar
Harald Staff Skrevet 7. august 2016 Del Skrevet 7. august 2016 Jeg skjønner at dette er litt mye. Det er fordi oppgaven er for stor. Prøv å brekke den ned i mindre deler og ta en om gangen. Hvordan får jeg noe til å skje når jeg skriver x i kolonne P? Og om de skriver X istedet? Hvordan få til en ja-nei-boks? Hvordan overføre informasjon fra ett ark til et annet? Og så må du tenke på navnelikhet. Det er utallige nordmenn som heter Jan Johansen, du risikerer at fler av dem handler hos deg. Ikke gi deg, dette er gøy. Beste hilsen Harald Lenke til kommentar
Trelkrok Skrevet 7. august 2016 Forfatter Del Skrevet 7. august 2016 Jeg skjønner at dette er litt mye. Det er fordi oppgaven er for stor. Prøv å brekke den ned i mindre deler og ta en om gangen. Hvordan får jeg noe til å skje når jeg skriver x i kolonne P? Og om de skriver X istedet? Hvordan få til en ja-nei-boks? Hvordan overføre informasjon fra ett ark til et annet? Og så må du tenke på navnelikhet. Det er utallige nordmenn som heter Jan Johansen, du risikerer at fler av dem handler hos deg. Ikke gi deg, dette er gøy. Beste hilsen Harald Takk for tips og oppmuntrende ord Harald. Gir meg nok ikke, men sliter nå. Og ja, GØY er det Lenke til kommentar
Trelkrok Skrevet 13. august 2016 Forfatter Del Skrevet 13. august 2016 (endret) Hei igjen, jeg valgte og hoppe over automatisk overføring fra Bestillingslisten. Laget heller en knapp for og slette grønne rader. Til mitt / vårt bruk tror jeg dette skal fungere bra. Ser dette greit ut tror dere? Sub SletteGrønneRader() '======================================================================== 'SLETTE ALLE RADER DER DET ER SATT X I KOLONNE Q (GRØNNE RADER) '======================================================================== Dim Msg As String, Ans As Variant Msg = "NB! Er det opprettet Pakkseddel på alle GRØNNE rader?" Ans = MsgBox(Msg, vbYesNo) Select Case Ans Case vbYes ActiveSheet.Unprotect Password:="****" Range("C3:I3").Select Selection.AutoFill Destination:=Range("C3:I1000"), Type:=xlFillDefault Range("C3:I1000").Select Range("C3:R3").Select Selection.Copy Range("C4:R1000").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Last = Cells(Rows.Count, "Q").End(xlUp).Row For i = Last To 1 Step -1 If (Cells(i, "Q").Value) = "x" Then 'Sletter rad med x i kolonne Q Cells(i, "A").EntireRow.Delete End If Next i Case vbNo GoTo Quit: End Select Quit: Range("B3").Select ActiveSheet.Protect Password:="****" End Sub Endret 15. august 2016 av Trelkrok Lenke til kommentar
Trelkrok Skrevet 22. august 2016 Forfatter Del Skrevet 22. august 2016 Hei igjen, har prøvd meg litt på det jeg egentlig hadde som mål. Koden under fungerer helt fint men har kjørt meg fast (har ikke gitt opp ) Jeg skulle hatt kopiert inn på første ledige rad fra C19:D19 og nedover. Sånn det er nå kommer det en tom linje på Pakkseddel hvis det er en sort som ikke er bestilt. Og Harald, jeg har ikke glemt navnelikhet men trenger nok et tips her også Håper noen kan gi meg en hjelpende hånd Ha en fin kveld Mvh RA Sub Opprette_Pakkseddel() 'denne sletter også bestillingsraden Dim Msg As String, Ans As Variant Msg = "Vil du opprette Pakkseddel på denne kunden?" & vbNewLine & "Til orientering slettes bestillingen." Ans = MsgBox(Msg, vbYesNo) Select Case Ans Case vbYes Application.ScreenUpdating = False Dim sh1ws As Worksheet Dim sh2ws As Worksheet Set sh1ws = Worksheets("Bestillingsliste ved") Set sh2ws = Worksheets("Pakkseddel") sh1ws.Activate sh1ws.Cells(ActiveCell.Row, 1).Copy Sheets("Bestillingsliste ved").Select sh1ws.Cells(ActiveCell.Row, 2).Copy Destination:=sh2ws.Range("B10") sh1ws.Cells(ActiveCell.Row, 10).Copy Destination:=sh2ws.Range("D18") sh1ws.Cells(ActiveCell.Row, 11).Copy Destination:=sh2ws.Range("D19") sh1ws.Cells(ActiveCell.Row, 12).Copy Destination:=sh2ws.Range("D20") sh1ws.Cells(ActiveCell.Row, 13).Copy Destination:=sh2ws.Range("D21") sh1ws.Cells(ActiveCell.Row, 14).Copy Destination:=sh2ws.Range("D25") sh1ws.Cells(ActiveCell.Row, 15).Copy Destination:=sh2ws.Range("D28") Application.CutCopyMode = False ActiveCell.EntireRow.Delete Sheets("Pakkseddel").Select If Range("D18").Value > 0 Then Sheets("Bestillingsliste ved").Select Range("J2").Select Selection.Copy Sheets("Pakkseddel").Select Range("C18").Select ActiveSheet.Paste Else End If DoEvents Sheets("Pakkseddel").Select If Range("D19").Value > 0 Then Sheets("Bestillingsliste ved").Select Range("K2").Select Application.CutCopyMode = False Selection.Copy Sheets("Pakkseddel").Select Range("C19").Select ActiveSheet.Paste Else End If DoEvents Sheets("Pakkseddel").Select If Range("D20").Value > 0 Then Sheets("Bestillingsliste ved").Select Range("L2").Select Application.CutCopyMode = False Selection.Copy Sheets("Pakkseddel").Select Range("C20").Select ActiveSheet.Paste Else End If DoEvents Sheets("Pakkseddel").Select If Range("D21").Value > 0 Then Sheets("Bestillingsliste ved").Select Range("M2").Select Application.CutCopyMode = False Selection.Copy Sheets("Pakkseddel").Select Range("C21").Select ActiveSheet.Paste Else End If DoEvents Sheets("Pakkseddel").Select If Range("D25").Value > 0 Then Sheets("Bestillingsliste ved").Select Range("N2").Select Application.CutCopyMode = False Selection.Copy Sheets("Pakkseddel").Select Range("C25").Select ActiveSheet.Paste Else End If DoEvents Sheets("Pakkseddel").Select If Range("D28").Value > 0 Then Sheets("Bestillingsliste ved").Select Range("O2").Select Application.CutCopyMode = False Selection.Copy Sheets("Pakkseddel").Select Range("C28").Select ActiveSheet.Paste Else End If Sheets("Pakkseddel").Select Range("B7").Select Case vbNo GoTo Quit: End Select Quit: End Sub Lenke til kommentar
Trelkrok Skrevet 24. august 2016 Forfatter Del Skrevet 24. august 2016 Hei igjen! Jeg har endret ovenforstående kode. Denne gjør samme jobben gitt Det jeg fortsatt mangler er: Der fet skrift i koden starter skal dette legge seg på første ledige rad fra og med C18:D18 i "Pakkseddel" Noen tips! Ha en fortreffelig dag Mvh RA Sub TEST_Klikk() Dim Msg As String, Ans As Variant Msg = "Vil du opprette Pakkseddel på denne kunden?" Ans = MsgBox(Msg, vbYesNo) Select Case Ans Case vbYes Application.ScreenUpdating = False Dim sh1ws As Worksheet Dim sh2ws As Worksheet Set sh1ws = Worksheets("Bestillingsliste ved") Set sh2ws = Worksheets("Pakkseddel") sh1ws.Activate Sheets("Bestillingsliste ved").Select sh1ws.Cells(ActiveCell.Row, 2).Copy Destination:=sh2ws.Range("B10") If sh1ws.Cells(ActiveCell.Row, 10) > 0 Then Range("J2").Copy Destination:=sh2ws.Range("C18") sh1ws.Cells(ActiveCell.Row, 10).Copy Destination:=sh2ws.Range("D18") Else End If If sh1ws.Cells(ActiveCell.Row, 11) > 0 Then Range("K2").Copy Destination:=sh2ws.Range("C19") sh1ws.Cells(ActiveCell.Row, 11).Copy Destination:=sh2ws.Range("D19") Else End If If sh1ws.Cells(ActiveCell.Row, 12) > 0 Then Range("L2").Copy Destination:=sh2ws.Range("C20") sh1ws.Cells(ActiveCell.Row, 12).Copy Destination:=sh2ws.Range("D20") Else End If If sh1ws.Cells(ActiveCell.Row, 13) > 0 Then Range("M2").Copy Destination:=sh2ws.Range("C21") sh1ws.Cells(ActiveCell.Row, 13).Copy Destination:=sh2ws.Range("D21") Else End If If sh1ws.Cells(ActiveCell.Row, 14) > 0 Then Range("N2").Copy Destination:=sh2ws.Range("C25") sh1ws.Cells(ActiveCell.Row, 14).Copy Destination:=sh2ws.Range("D25") Else End If If sh1ws.Cells(ActiveCell.Row, 15) > 0 Then Range("O2").Copy Destination:=sh2ws.Range("C28") sh1ws.Cells(ActiveCell.Row, 15).Copy Destination:=sh2ws.Range("D28") Application.CutCopyMode = False Else End If Sheets("Pakkseddel").Select Range("B7").Select Case vbNo GoTo Quit: End Select Quit: End Sub Lenke til kommentar
Trelkrok Skrevet 29. august 2016 Forfatter Del Skrevet 29. august 2016 Hei igjen, da jeg ikke var fornøyd med kodene over har jeg laget en ny. Etter testing fungerer denne bra men kan sikkert skrives kortere. Har valgt og sette "x" automatisk når Pakkseddel opprettes fra bestillingslisten. Linjen i bestillingslisten blir da grønn (betinget formatering) som indikerer at Pakkseddel er opprettet. Disse linjene kan så slettes via en egen knapp. Som Harald har nevnt, har også jeg funnet ut at det er bedre med en knapp for og utløse en handling. Det eneste jeg nå mangler er og sjekke så rett navn kommer inn i Pakkseddel (navnelikhet) Mener dette må inn i det som er uthevet med fet skrift i makroen. Da er det vel gateadresse i "Pakkseddel" B11 som må sjekkes så den stemmer med gateadresse i den aktive raden i "Bestillingsliste ved" som ligger i kolonne C. Noen forslag på hvordan jeg kan gjøre dette? Ser dere ellers noen svakheter i koden under så si gjerne ifra Mvh RA Sub Overføre_bestilling_til_Pakkseddel() Dim Msg As String, Ans As Variant Msg = "Vil du opprette Pakkseddel på denne kunden?" Ans = MsgBox(Msg, vbYesNo) Select Case Ans Case vbYes Application.ScreenUpdating = False 'skjuler hva som skjer Application.Calculation = xlCalculationManual 'Excel regner ikke ut ActiveSheet.Unprotect Password:="****" Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 2).Copy Sheets("Pakkseddel").Select Range("B10:F10").Select ActiveSheet.Paste Application.CutCopyMode = False DoEvents Sheets("Bestillingsliste ved").Select If Cells(Application.ActiveCell.Row, 10) > 0 Then Range("J2").Copy Sheets("Pakkseddel").Select Range("C18").End(xlUp).Offset(1).PasteSpecial xlPasteValues Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 10).Copy Sheets("Pakkseddel").Select Range("D18").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = False Else End If DoEvents Sheets("Bestillingsliste ved").Select If Cells(Application.ActiveCell.Row, 11) > 0 Then Range("K2").Copy Sheets("Pakkseddel").Select Range("C19").End(xlUp).Offset(1).PasteSpecial xlPasteValues Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 11).Copy Sheets("Pakkseddel").Select Range("D19").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = Fals Else End If DoEvents Sheets("Bestillingsliste ved").Select If Cells(Application.ActiveCell.Row, 12) > 0 Then Range("L2").Copy Sheets("Pakkseddel").Select Range("C20").End(xlUp).Offset(1).PasteSpecial xlPasteValues Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 12).Copy Sheets("Pakkseddel").Select Range("D20").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = Fals Else End If DoEvents Sheets("Bestillingsliste ved").Select If Cells(Application.ActiveCell.Row, 13) > 0 Then Range("M2").Copy Sheets("Pakkseddel").Select Range("C21").End(xlUp).Offset(1).PasteSpecial xlPasteValues Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 13).Copy Sheets("Pakkseddel").Select Range("D21").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = Fals Else End If DoEvents Sheets("Bestillingsliste ved").Select If Cells(Application.ActiveCell.Row, 14) > 0 Then Range("N2").Copy Sheets("Pakkseddel").Select Range("C22").End(xlUp).Offset(1).PasteSpecial xlPasteValues Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 14).Copy Sheets("Pakkseddel").Select Range("D22").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = Fals Else End If DoEvents Sheets("Bestillingsliste ved").Select If Cells(Application.ActiveCell.Row, 15) > 0 Then Range("O2").Copy Sheets("Pakkseddel").Select Range("C23").End(xlUp).Offset(1).PasteSpecial xlPasteValues Sheets("Bestillingsliste ved").Select Cells(Application.ActiveCell.Row, 15).Copy Sheets("Pakkseddel").Select Range("D23").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = Fals Else End If DoEvents Sheets("Bestillingsliste ved").Select Cells(ActiveCell.Row, 17) = "x" 'ActiveCell.EntireRow.Delete 'Har valgt og ikke bruke denne da jeg sletter grønne linjer (med x) med egen knapp. Range("C3:I3").Select Selection.AutoFill Destination:=Range("C3:I1000"), Type:=xlFillDefault Range("C3:I1000").Select Range("C3:R3").Select Selection.Copy Range("C4:R1000").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("B3").Select Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning Application.ScreenUpdating = True 'viser hva som skjer igjen ActiveSheet.Protect Password:="****" DoEvents Sheets("Pakkseddel").Select Range("B7").Select ActiveSheet.Protect Password:="****" DoEvents Case vbNo GoTo Quit: End Select Quit: End Sub Lenke til kommentar
Trelkrok Skrevet 5. september 2016 Forfatter Del Skrevet 5. september 2016 (endret) Hei igjen! Da har jeg løst problemet med navnliket, nesten. . Jeg har en sammenslått celle B10:F10 i fanene ‘Pakkseddel’, i denne har jeg en datavalideringsliste fra kunderegister. Har slått sammen kundenummer og kundenavn i fanen ’Kunderegister’ for å eliminere navnlikhet. I fanen Pakkseddel B10:F10 får jeg da '1313 Hans Hansen' Er det mulig å få til så bare Hans Hansen blir synlig? (1313 må være med men skal ikke være synlig og det kan ikke være en formel som gjør dette) Eller må det til en vba kode? I så fall tar jeg gjerne imot tips til denne. Mvh RA Endret 5. september 2016 av Trelkrok Lenke til kommentar
Harald Staff Skrevet 5. september 2016 Del Skrevet 5. september 2016 Hei igjen Hvordan velger du hvilken Hans Hansen det gjelder? Det bør være det øyeblikket som overfører adresse, mobilnummer og hvavetjeg. Best hilsen Harald Lenke til kommentar
Trelkrok Skrevet 5. september 2016 Forfatter Del Skrevet 5. september 2016 (endret) Hei igjen Hvordan velger du hvilken Hans Hansen det gjelder? Det bør være det øyeblikket som overfører adresse, mobilnummer og hvavetjeg. Best hilsen Harald Hei, det velger jeg fra datavalideringsliste eller via Userform, se bilde Edit. I userform kan man også søke på kundenummer Gateadresse kommer med denne formelen: =HVISFEIL(FINN.RAD($B$10;Kunderegister!$AN:$AU;2;USANN);"") og postnummer og sted med denne: =HVISFEIL(FINN.RAD($B$10;Kunderegister!$AN:$AU;3;USANN) & " " & FINN.RAD($B$10;Kunderegister!$AN:$AU;4;USANN);"") osv. RA Endret 5. september 2016 av Trelkrok Lenke til kommentar
Harald Staff Skrevet 5. september 2016 Del Skrevet 5. september 2016 Den enkleste løsningen er å skjule B10 (dra-slipp til en rad eller kolonne du senere skjuler), og så splitter innholdet i synlige felt "Kunde" (Tekst fra første mellomrom) og eventuelt "Kundenummer" (tekst til første mellomrom, du kan ha nytte av det som avsender). Enkelhet, som for eksempel forståelige hjelpekolonner, er slett ikke et nederlag Beste hilsen Harald Lenke til kommentar
Trelkrok Skrevet 5. september 2016 Forfatter Del Skrevet 5. september 2016 (endret) Den enkleste løsningen er å skjule B10 (dra-slipp til en rad eller kolonne du senere skjuler), og så splitter innholdet i synlige felt "Kunde" (Tekst fra første mellomrom) og eventuelt "Kundenummer" (tekst til første mellomrom, du kan ha nytte av det som avsender). Enkelhet, som for eksempel forståelige hjelpekolonner, er slett ikke et nederlag Beste hilsen Harald Hei igjen Harald, og TUSEN takk for tips. Da ble det hjelpekolonner. Valgte og ta med gateadressen i kunderegister så ser man med en gang rett kunde. Er litt usikker på om jeg skal ha med kundenummer i Userform, hva tror du/dere, blir kanskje litt mye informasjon i søkeboksen. Dette komme jo i K10 på Pakkseddel også. Har lagt ved bilder av formelen og hva den viser, som resultatet vises det en komma bak navnet men den vet jeg ikke hvordan jeg skal bli kvittt. Har lagt ved bilde av Userform også sånn den er nå. Mva RA Endret 5. september 2016 av Trelkrok Lenke til kommentar
Harald Staff Skrevet 6. september 2016 Del Skrevet 6. september 2016 Trekk fra kommaposisjonen, som er ett tegn: FINN(",";M10;1)-1 Ute i virkeligheten er det mye bøll med enkle og doble mellomrom før og etter tekst og skilletegn. Du kan ha glede av TRIMME i tillegg til HVISFEIL når du jobber med tekst. Jeg finner stor glede i at du åpenbart synes dette er gøy. Det er jo det. Beste hilsen Harald Lenke til kommentar
Trelkrok Skrevet 6. september 2016 Forfatter Del Skrevet 6. september 2016 Trekk fra kommaposisjonen, som er ett tegn: FINN(",";M10;1)-1 Ute i virkeligheten er det mye bøll med enkle og doble mellomrom før og etter tekst og skilletegn. Du kan ha glede av TRIMME i tillegg til HVISFEIL når du jobber med tekst. Jeg finner stor glede i at du åpenbart synes dette er gøy. Det er jo det. Beste hilsen Harald Hei igjen og atter en gang TUSEN TAKK for svar, så enkelt kan det løses Da setter jeg denne delen som løst. Takk til alle som har deltatt . Godt og få råd og veiledning når man trenger det, er tross alt bare en amatør som syns dette er veldig moro. Mvh RA Lenke til kommentar
Anbefalte innlegg
Opprett en konto eller logg inn for å kommentere
Du må være et medlem for å kunne skrive en kommentar
Opprett konto
Det er enkelt å melde seg inn for å starte en ny konto!
Start en kontoLogg inn
Har du allerede en konto? Logg inn her.
Logg inn nå