[VBA] Offset/Move Values

timdecker · Apr 27th 2016

I am having an issue manipulating a flat file. The macro I have right now does everything I need, except for one thing.

I sometimes have values in extended columns, rather than below onto the next row. How can I shift/offset these values to the rows below.

I have 2 grids below, one with an example as it is now and another of what I would like to occur. The values that change will be in RED. The values in RED are sporadic, in terms of which flat file they show up in. I made them red to make it easier to find, they are only red for this example and it is not indicative of any other file set.

Also, I have attached an example excel document with sample data.

Thanks!

Example - Ugly:
[ATTACH=CONFIG]68967[/ATTACH]

Example - Good:
[ATTACH=CONFIG]68968[/ATTACH]

Links to other forums:
Contains link to download data in xlsx: http://www.excelforum.com/exce…value-details-inside.html
Has data in forum table: http://www.mrexcel.com/forum/e…set-shift-move-value.html

Thanks for the help!

timdecker · Apr 28th 2016

Re: [VBA] Offset/Move Values

This thread is currently being updated @ http://www.excelforum.com/showthread.php?t=1137023&p=4374372

I will post the final script once it is completed.

skywriter · Apr 28th 2016

Re: [VBA] Offset/Move Values

I changed my mind.

timdecker · Apr 28th 2016

Re: [VBA] Offset/Move Values

Well, thanks for getting me on the right track everyone, especially 6StringJazzer @ EF. Here is the final product:

Code

Sub M()
     
    Dim LastRow As Long
    Dim lColumn As Long 'last column
    Dim lc As Integer
    Dim row As Integer
    Dim col As Integer
    Dim loopCounter As Integer




    lColumn = ActiveSheet.UsedRange.column + ActiveSheet.UsedRange.Columns.Count - 1
    LastRow = ActiveSheet.Cells(Rows.Count, "G").End(xlUp).row
    
    'save last column number in used range
    lc = ActiveSheet.Cells.SpecialCells(xlLastCell).column




    Columns(9).Delete
    Columns(8).Delete
    
    'Loop for each column number until it equals 0
    Do Until lc = 0
        If WorksheetFunction.CountA(Columns(lc)) = 0 Then
            Columns(lc).Delete
        End If
        'proceeds to the next lowest column number
        lc = lc - 1
        
    Loop




    row = 1
    loopCounter = 1
    Do While (row <= LastRow)
        For col = 5 To lColumn
            If (col Mod 2 <> 0) Then
                If (Cells(row, col).value <> "") Then
                    'Debug.Print row & "," & col
                    Cells(row, col).Offset(loopCounter).EntireRow.Insert
                    Cells(row + loopCounter, 3) = Cells(row, col)
                    Cells(row + loopCounter, 4) = Cells(row, col + 1)
                    loopCounter = loopCounter + 1
                    'Debug.Print "counter " & loopCounter
                End If
            End If
        Next col
        LastRow = LastRow + loopCounter - 1
        Debug.Print "new last row = " & LastRow
        loopCounter = 1
        row = row + 1
    
    Loop
    
End Sub

Display More

[VBA] Offset/Move Values

Participate now!

Share