Home > database >  Cycle value's in set cells
Cycle value's in set cells

Time:01-11

I'm trying to make value's cycle with VBA (or another way).

The idea is that when the button is pressed that all values go forward, and the first one is moved to the back.

The cells with a value are C4, F4, I4, L4, O4, R4, U4, X4, AA4 and AD4 (always 2 cells in between.)

Also, not all 10 cells are always in use, sometimes there are only 2 or three, but other times you also have 7 or up to all 10.

Values are inputted the first time with a drop-down menu.

This is the macro I tried to use, this one just gives error 1004 :

Sub cycle()

Range("C4").Select
Selection.Copy
Range("AG15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("F4:AD4").Select
Application.CutCopyMode = False
Selection.Copy
Range("C4").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
    IconFileName:=False
Range("AG15").Select
Selection.Copy
Sheets("Blad1").Select
Range("C5").Select
Range(Selection, Selection.End(xlRight)).Select
Selection.Copy
Range("AG15").Select
Application.CutCopyMode = False
Selection.ClearContents

End Sub

enter image description here Added a screenshot as example with 4 values. Just keep in mind this can be up to 10 values.

I already tried to just copy the value of C4 to another cell, then select F4 till AD4, copy them end paste to C4, and then copy the one that was set aside, back to the first available of those 10 cells, starting from the left, but it messed up the whole excel, so deleted that one.

CodePudding user response:

Cycle Range Values

Option Explicit

Sub CycleLeft()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("Blad1")
    Dim rg As Range: Set rg = ws.Range("C4,F4,I4,L4,O4,R4,U4,X4,AA4,AD4")
    
    Dim currentCell As Range, previousCell As Range, CurrentValue, FirstValue
    Dim IsNotFirst As Boolean
    
    For Each currentCell In rg.Cells
        CurrentValue = currentCell.Value
        If Len(CStr(CurrentValue)) > 0 Then ' is not blank
            If IsNotFirst Then
                previousCell.Value = CurrentValue
            Else
                FirstValue = CurrentValue
                IsNotFirst = True
            End If
            Set previousCell = currentCell
        End If
    Next currentCell
    
    If Not previousCell Is Nothing Then previousCell.Value = FirstValue

End Sub
  • Related