CODEWITHSUNDEEP
excelvba
ASH
ASH

Reputation: 20302

How to swap values in cells

So, I am trying to swap values in cells next to each other, staring in cell G2, and keep doing this as you move right, until an empty cell is found in the row. Then, move down one row, and do the same, moving right, until an empty cells if found. Then move down, and so on and so forth. The tricky thing is that the columns vary greatly, from around 20 to over 3000. Everything starts in cell G2, and in this case it goes down to G100, but that could change anytime. So far, I can find the right-most column and set the looping range, but the loop itself is off, so this doesn't work right. Any thoughts, experts?

Here is the code sample that I am testing.

Dim LastColumn As Long
With ActiveSheet.UsedRange
    LastColumn = .Columns(.Columns.Count).Column
End With

Dim ColumnNumber As Long
Dim ColumnLetter As String
ColumnLetter = Split(Cells(1, LastColumn).Address, "$")(1)

    Columns("G:" & ColumnLetter).Select
    Selection.Replace What:="name: ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="- data_type: ", Replacement:="", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

' start to swap cell contents...
Dim r As Range
Dim c As Range
Dim sht As Worksheet
Dim LastRow As Long
Dim temp As Double

Set sht = ActiveSheet
LastRow = sht.Cells(sht.Rows.Count, "G").End(xlUp).Row

Set r = Range("G2:" & ColumnLetter & LastRow)

For Each c In r
    c.Select
    temp = ActiveCell.Value
    ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value & ":" & temp
    ActiveCell.Offset(0, 2).Select
Next

Upvotes: 0

Views: 243

Answers (1)

user4039065
user4039065

Reputation:

Loop through the columns numerically and use some basic maths to determine the source(s) and destination.

Option Explicit

Sub consolidate()
    Dim r As Long, c As Long, d As Long

    With Worksheets(ActiveSheet.Name)
        For r = 2 To .Cells(.Rows.Count, "G").End(xlUp).Row
            d = 7
            For c = 7 To .Cells(r, .Columns.Count).End(xlToLeft).Column Step 2
                .Cells(r, d) = Join(Array(.Cells(r, c).Value, _
                                          .Cells(r, c + 1).Value), Chr(32))
                 d = d + 1
            Next c
            .Range(.Cells(r, d), .Cells(r, .Columns.Count).End(xlToLeft)).Clear
        Next r
    End With
End Sub

Upvotes: 3

Related Questions