CODEWITHSUNDEEP
vbaexcel
Shrewd1
Shrewd1

Reputation: 53

Move data to adjacent columns based on date (month) value

Moving expense data from columns K:M to respective columns N:Y (Jan, Feb, Mar, etc.) based on date (month) in column AA, but any future dates in column AA are populating the data in the future (forward) and not historically as desired?

Sub MoveData() 
Dim vals As Range, val As Range, colOffset As Integer 
Set vals = Range("K2:K" & Range("K2").End(xlDown).Row) 

For Each val In vals 

 If val > 0 Then 
  colOffset = VBA.month(val.offset(0, 16)) 
  val.offset(0, colOffset) = val 
  val.offset(0, colOffset + 1) = val.offset(0, 1) 
  val.offset(0, colOffset + 2) = val.offset(0, 2) 
 End if 

 Next val 
End Sub

!Exampleenter image description here

Upvotes: 0

Views: 1348

Answers (1)

user3598756
user3598756

Reputation: 29421

edited after OP's further specs

not sure I grasped the logic you need, but try this

Option Explicit

Sub MoveData()
Dim colOffset As Integer, dataCols As Long
Dim datesRng As Range, dateRng As Range, valsRng As Range

With ThisWorkbook.Worksheets("expenses") '<== change it to your actual sheet name
    Set datesRng = .Range("AA2:AA" & .Cells(.rows.Count, "AA").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlNumbers) 'process rows as long as there's a "Transition Date"

    For Each dateRng In datesRng
        With .Range("K" & dateRng.Row)
            dataCols = WorksheetFunction.CountA(.Resize(, 3))
            Set valsRng = .Offset(, 3 - dataCols).Resize(, dataCols)
        End With

        colOffset = WorksheetFunction.Min(Month(dateRng), Month(Date)) - dataCols 'limit month offset to current one and set it back to the numbers of values
        If colOffset >= 0 Then
            .Range("N" & dateRng.Row).Offset(, colOffset).Resize(, dataCols).Value = valsRng.Value
            .Range("N" & dateRng.Row).Offset(, colOffset).Value = .Range("N" & dateRng.Row).Offset(, colOffset) - .Range("J" & dateRng.Row).Value
        Else
            'some K-L columns data would be overwritten!!
        End If

    Next dateRng
End With

End Sub

Upvotes: 1

Related Questions