VBA - Swapping cells until condition is met

user_16375831 0
Viewed 81

I'm new to vba and have trouble with swapping cells through a conditional loop.

I have a table which looks like

enter image description here

and want to transform it (move numeric cells to column b and remove non-numeric values) into

enter image description here

Right now I have the code

Sub Swap()

 With ThisWorkbook.Sheets("Sheet1")
     For j = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
         If IsNumeric(.Cells(j, 2)) = False Then
             For k = 2 To .Cells(j, Columns.Count).End(xlToLeft).Columns
                 Do Until IsNumeric(.Cells(j, 2)) = True
                     t = .Cells(j, k)
                     .Cells(j, k) = .Cells(j, k + 1)
                     .Cells(j, k + 1) = t
                 Loop
             Next k
         Else
         End If
     Next j
 End With
End Sub

which works fine until line 9, where it keeps swaping B9 and C9 in an endless loop.

I hope anyone can help me

vba excel
4 Answers

Conditional Loop

Option Explicit

Sub Swap()

    Dim rg As Range
    With ThisWorkbook.Sheets("Sheet1")
        Dim lCell As Range
        Dim lRow As Long
        With .UsedRange
            Set lCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
            If lCell Is Nothing Then Exit Sub
            lRow = lCell.Row
            Set lCell = .Find("*", , xlFormulas, , xlByColumns, xlPrevious)
        End With
        Set rg = .Range("B1", .Cells(lRow, lCell.Column))
    End With
    
    Dim Data As Variant: Data = rg.Value
    Dim rCount As Long: rCount = UBound(Data, 1)
    Dim cCount As Long: cCount = UBound(Data, 2)
    
    Dim cValue As Variant
    Dim r As Long
    Dim c As Long
    Dim NumberFound As Boolean
    
    For r = 1 To rCount
        For c = 1 To cCount
            cValue = Data(r, c)
            If VarType(cValue) = vbDouble Then
                NumberFound = True
                Exit For
            End If
        Next c
        If NumberFound Then
            Data(r, 1) = cValue
            NumberFound = False
        Else
            Data(r, 1) = Empty ' no number found
        End If
        For c = 2 To cCount
            Data(r, c) = Empty
        Next c
    Next r
    
    rg.Value = Data

End Sub
user_98140690

… It's doing exactly what you told it to.

You have a Do Until check on B9, where you swap it with cell C9. So, it starts as "ee", and you swap them. Now it is "e", so you swap them. It's "ee" again, so it swaps them again. Repeat ad nauseum

You need to rethink that Do Until. A crude Brute Force approach would be to Delete the cell with the "shift left" parameter. Another method would be to put the For k = 2.. loop inside the Do Until loop, rather than the other way around.

user_92909860

When the algorithm Arive to 9's row it fall in loop because cell 2 and 3 both are unumeric (e, ee) and you're swapping them to infinity... Its better to do this steps for each row: 1- iterate all over the row's cells to find numeric one and copy that 2- clean all not needed cells and make them blank 3- fill second cell of row by copied number 4- done!

user_128024190

The code below uses Excel's MAX function, since it will happily ignore any non-numeric data in the range and simply return the (single) numeric datum (to the variable number):

Sub unConditional()
    Dim lastRow As Long, i As Long, number As Long, dataRow As Range
    With Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 1 To lastRow
            Set dataRow = .Cells(i, 2).Resize(1, .Cells(i, 1).End(xlToRight).Column - 1)
            number = WorksheetFunction.Max(dataRow)
            dataRow.ClearContents
            .Cells(i, 2).Value2 = number
        Next i
    End With
End Sub
user_188247270
Related