Macro til at flytte row

Jeg sad og testede lidt, og man kunne godt eks. skrive

If X = "" Then MsgBox "Du skrev ikke en række"

Men derefter laver den en fejl når den forsøger at selecte Range("A" & X)

Derudover skal der også laves en If, så hvis man vælger andet en et tal (eks. skriver "ko") i Inputboxen, kommer der også en MsgBox.

Her er lidt inspiration til "opgaven" - hvad mener du med:
"I den samme InputBox, er det så muligt at fjerne "Cancel" knappen, eller evt. køre proceduren baglæns hvis man gør?"


Sub MoveRow()
Dim lRow As Long, rCell As Range
Dim lFirstRow As Long, lLastRow As Long, X, flytRæk, notOK As String

    If Range("T" & Selection.Row) <> "S" Then
        MsgBox "Du kan ikke flytte denne/disse rækker.."
        Exit Sub
    End If
   
    notOK = " "

    If Selection.Areas.Count = 1 And Selection.Columns.Count = 1 Then
            flytRæk = Selection.Rows.Count      'antal rækker, der skal flyttes
           
            Selection.EntireRow.Cut
           
            X = InputBox("Hvilken række skal rækken/rækkerne indsættes i?")
            If X = "" Then
                MsgBox "Du skrev ikke en række"
            Else
                If IsNumeric(X) = False Then
                    MsgBox ("Rækkenr. skal være numerisk")
                Else
                    notOK = testOmOk(flytRæk, X)
                    If notOK = "" Then
                        Range("A" & X).Select
                        Selection.EntireRow.Insert
                    Else
                        MsgBox ("Der kan ikke indsættes i række(rne): " + notOK)
                    End If
                End If
            End If
    Else
        MsgBox "Du skal vælge rækker kontinuerligt"
    End If
End Sub
Private Function testOmOk(antalræk, tilræk)
Dim Rækstr
    Rækstr = ""
    For ræk = tilræk To tilræk + antalræk - 1
        If Cells(ræk, 17) <> "A" Then
            Rækstr = Rækstr + CStr(ræk) + "|"
        End If
    Next ræk
    testOmOk = Rækstr
End Function

Her kører den i loop intil det er et tal.
Do
            X = InputBox("Hvilken række skal rækken/rækkerne indsættes i?")
        Loop Until IsNumeric(X)

#supertekst
Nu har jeg kun lige haft 20 min til a se på den, men meget af det ser rigtigt ud. Dog ser det en anelse kringlet at styre hvilke linier rækkerne kan indsættes på.. eller er det bare mig?
Jeg havde nok håbet lidt på en løsning alá "If Range ("U" & lRow) = "S" Then MsgBox ("Der kan ikke indsættes i ") hvis du forstår? (Det kan også være man kan det med din "inspiration" ;) -men kan ikke se hvilke celler den kontrollere..

Mht. hvad jeg mente med "I den samme InputBox, er det så muligt at fjerne "Cancel" knappen, eller evt. køre proceduren baglæns hvis man gør?" -så var det sådan set, enten at tvinge folk til at give et svar (som kabbak skriver, "Loop Until IsNumeric(X)") eller hvis man simpelthen kunne fjerne selve knappen "Cancel" fra InputBox'en.

Det er nok et spørgsmål om detailler i selve funktioneringen.
Hvis der markeres rækker, der ikke indeholder "S" - skal markeringen gøres om - iflg. din kode - altså hvis række, der flyttes til ikke indeholder "A" (eks)- så vælg ny startrække - eller?

Jo det lyder umiddelbart rigtigt..


På http://picasaweb.google.com/simon.saxtorph/Excelark kan du se et screenshot af hvordan skemaet skal se ud.. (se på det første billede)

Skemaet vil bruge brugt til sagsbehandling af en masse forskellig mennesker derfor har jeg valgt at låse dokumentet. Men som du kan se, skal de samme mennesker kunne indsætte nye sager, derfor har jeg lavet forskellig makroer der kontrollere om jeg har valgt at linierne er beskyttet. I linierne 19 samt 34, står der et S i række G. Disse to steder er de eneste steder jeg vil have folk til at kunne indsætte nye rækker i, og ligeledes når man flytter sager fra nederste del (ultimo marts) til øverste (primo april, pga. ny måned) skal række 19 og 34 også være de eneste de kan flytte rækkerne til.

Men igen, de eneste rækker der skal kunne flyttes, er dem hvor der står et S i række H -hvor jeg har skrevet T i koden oven over..


På billede nr. 2, kan man se at der bliver endnu en inddeling af primo/ultimo, nemlig med hvem der er ansvarlig for disse sager. Derfor kommer det ikke kun til at være række 19 og 34 den skal læse, men den skal scanne kollonnen og se om den parameter mand har sat ind ("S") er til stede, og hvis den er, kan man flytter rækkerne..

Jeg håber jeg har gjort det forståeligt nok :)

Tak for info'en - jeg vil - når tiden tillader det - se lidt nærmere på det...

Det lyder rigtig godt! Glæder mig til at se hvad der kommer ud af det :)

Jeg har arbejdet lidt videre på den første (min egen) kode, og har fået det her:


Sub FlytReakke()

FlytReakkeInfo.Show

Dim lRow As Long, rCell As Range
Dim lFirstRow As Long, lLastRow As Long

If Range("U" & Selection.Row) <> "S" Then
    FlytReakke_fejl.Show
    Exit Sub
End If

If Selection.Areas.Count = 1 And Selection.Columns.Count = 1 Then
       
        Selection.EntireRow.Cut
     
            Do
                X = InputBox("Hvilken række skal rækken/rækkerne indsættes i?")
                If X = "" Then Exit Sub
                Loop Until IsNumeric(X)
                       
           
                Range("A" & X).Select
                If Range("T" & Selection.Row) <> "S" Then FlytReakke_fejl.Show
                Application.CutCopyMode = False
                Exit Sub
       
        Selection.EntireRow.Insert

Else
    FlytReakke_fejl.Show
       
End If

End Sub



Det eneste jeg ikke kan få koden til, er at udføre denne test:

If Range("T" & Selection.Row) <> "S" Then FlytReakke_fejl.Show
                Application.CutCopyMode = False
                Exit Sub

Hvis jeg fjerne de 3 linier fungere den helt fint, og kopiere derhen den skal -men det er som om den glemmer den tidligere "Selection.EntireRow.Cut" idet den skal lave denne korte test. Kan man på en måde gemme den selection under et "XY" el. lign?


Derudover, den første test der bliver lavet er denne:

If Range("U" & Selection.Row) <> "S" Then
    FlytReakke_fejl.Show
    Exit Sub

Når jeg laver en selection på mere end en celle, tager den kun højde for den første jeg valgte, den tester ikke på resten af cellerne.
Jeg har forsøgt med med en "For each rCell in selection" i start og "Next rCell" i slut -men kan ikke hitte ud af hvor de skal placeres.. :(

Så er her et bud:
Sub FlytReakke()
Dim lRow As Long, rCell As Range
Dim lFirstRow As Long, lLastRow As Long
'    FlytReakkeInfo.Show
   
    For Each rCell In Selection.Rows
        r = rCell.Row
        If Cells(r, 21) <> "S" Then        '21=Kolonne U
            FlytReakke_fejlshow
            Exit Sub
        End If
    Next
   
    If Selection.Areas.Count = 1 And Selection.Columns.Count = 1 Then
            Selection.EntireRow.Cut
                Do
                    X = InputBox("Hvilken række skal rækken/rækkerne indsættes i?")
                    If X = "" Then Exit Sub
                Loop Until IsNumeric(X)
               
                Range("A" & X).Select
                If Range("T" & Selection.Row) <> "S" Then
                    FlytReakke_fejlshow
                    Application.CutCopyMode = False
                    Exit Sub
                Else
                    Selection.EntireRow.Insert
                End If
    Else
        FlytReakke_fejlshow
    End If
End Sub
Sub FlytReakke_fejlshow()
    MsgBox ("Fejl")
End Sub

Hm, strange.. jeg har lige haft svaret, men svaret er ikke dukket op. Anyways, så er det lige præcis hvad jeg har brug for!

Den eneste fejl jeg kan få til at fremkomme er, hvis jeg forsøger at indsætte linierne samme sted jeg kopiere dem fra. Altså hvis jeg vælger linie 5-10, og forsøger at indsætte dem i line 7 eks.
Er det muligt at tilrette det?

Derudover:
I linien

If X = "" Then Exit Sub
Loop Until IsNumeric(X)

Har jeg forsøgt at indsætte "Application.CutCopyMode = False" således at alt er deselected når man trykker cancel- jeg kan bare ikke få den til at gøre det.

Hvis jeg skriver

If X = "" Then Application.CutCopyMode = False
Exit Sub
Loop Until IsNumeric(X)

Så laver den en deselection uanset hvad, hvilket jeg synes er lidt mærkeligt.. Hvis det er nemt at fixe ville det være cool, ellers kan det være lige meget.

Mange tak for hjælpen ellers, kanon godt arbejde!

Selv tak - jeg fortsætter med det i morgen - med mindre tiden ikke tillader det...

Jeg kom lige lidt videre med første problem, nu mangler jeg bare en afslutning.

Nu ser starten af koden således ud:

For Each rCell In Selection.Rows
        r = rCell.Row
        If Cells(r, 21) <> "S" Then        '21=Kolonne U
            FlytReakke_fejl.Show
            ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            Application.ScreenUpdating = True
            Exit Sub
        Else
        Cells(r, 22).Value = ""

I min "V" kollonne har jeg skrevet et "S" ud fra de steder hvor linier må kopieres hen til, men da jeg også vil kunne flytte sager imellem hindanden står der et "S" i deres kolonne også. Med linie "Cells(r, 22).Value = """ bliver det "S" slettet, så den senere hen blot kommer med en fejlboks, da der jo ikke er et "S" i.
Man til sidst i koden skulle det "S" gerne tilbage i kolonne "V" igen, og helst i alle cellerne selvfølgelig..

Du må lige skrive hvis du vil have hele koden igen..

Jeg er kommet et skridt nærmere nu (puha, det er da også sent!!)

I stedet for "Cells(r, 22).Value = """ har jeg kaldt "" for "QQQ_1".

Til sidst i dokumentet laver jeg så en find & replace command -fungerer fint, men kan omgås. Hvis der er en bedre løsning ville det være fint.

Med hensyn til linie:
If X = "" Then Exit Sub
Loop Until IsNumeric(X)

...lærte jeg så lige at man kan adskille kommandoer med ":"

Hvis jeg skriver flg. virker det:

If X = "" Then Application.CutCopyMode = False: Exit Sub
Loop Until IsNumeric(X)
P*ssesmart :)

..men vend gerne tilbage med det andet -uanset hvad synes jeg nu efterhånden du har fortjent de point ;)

Et bidrag vedr. et af dine tidligere problemer:
                Do
                    X = InputBox("Hvilken række skal rækken/rækkerne indsættes i?")
                    If X = "" Then
Rem Ophæv markering v/Cancel
                        Application.CutCopyMode = False
                        Exit Sub
                    End If
                Loop Until IsNumeric(X)

Måske er det løst - hvis du vil have mere assistance - så giv signal - ellers tror jeg, at jeg stopper nu.

Det virker helt perfekt!
Hvis du giver et svar, så får du lige nogle point ;)

Tak for hjælpen!

Fint - her er det så - og selv tak...