VBA Code to move Data

[knaimi]

Please see excel table below:

Date	Description	Debit	Credit	Member Name
11/12/2023​	Item 1	$ 36.72		John Smith
11/12/2023​	Item 2	$ 23.40		John Smith
11/11/2023​	Item 3	$ 96.35		John Smith
11/7/2023​	Item 4		$(1,283.96)	Clara Smith
11/3/2023​	Item 5	$ 401.55		Clara Smith
11/3/2023​	Item 6	$ 67.00		Clara Smith
10/31/2023​	Item 7	$ 43.70		Clara Smith
10/30/2023​	Item 8	$ 26.68		John Smith
10/29/2023​	Item 9		$ (15.89)	John Smith
10/29/2023​	Item 10		$ (327.98)	John Smith
10/29/2023​	Item 11	$ 155.07		John Smith
10/29/2023​	Item 12	$ 44.77		John Smith

I’m trying to create a VBA code to move any numbers in column D (Credit) to the left cell in column C (Debit). Sometimes there are no numbers in column D, other times there is at least one. Basically I want all numbers in column C in with the same order



Thank you,



knaimi

 

[Legacy 143009]

Hello,

This must do the job:

Sub test()
  Dim columnC As Variant, columnD As Variant, i As Long
  columnC = Intersect(UsedRange, Columns("C"))
  columnD = Intersect(UsedRange, Columns("D"))
  For i = 2 To UBound(columnD, 1)
    If columnD(i, 1) <> "" Then
      columnC(i, 1) = columnD(i, 1)
    End If
  Next
  Range("C1").Resize(UBound(columnC, 1), 1).Value = columnC
End Sub

 

[RustamMika]

Hi ...
One more variant with minor changes:

Sub test()
  Dim arr As Variant, i As Long
     arr = [a1].CurrentRegion.Value
        For i = 2 To UBound(arr)
             If arr(i, 4) <> "" Then
              arr(i, 3) = arr(i, 4)
              arr(i, 4) = ""
            End If
        Next
  [a1].CurrentRegion.Value = arr
End Sub

 

[knaimi]

Hello,

This must do the job:

Sub test()
  Dim columnC As Variant, columnD As Variant, i As Long
  columnC = Intersect(UsedRange, Columns("C"))
  columnD = Intersect(UsedRange, Columns("D"))
  For i = 2 To UBound(columnD, 1)
    If columnD(i, 1) <> "" Then
      columnC(i, 1) = columnD(i, 1)
    End If
  Next
  Range("C1").Resize(UBound(columnC, 1), 1).Value = columnC
End Sub

Thank you Flashbond. I ran the code and it game with the following error

Run-time error ‘424’:

Object required

When I click on Debug, I got the following line highlighted:

columnC = Intersect(UsedRange, Columns("C"))

 

[knaimi]

Hi ...
One more variant with minor changes:

Sub test()
  Dim arr As Variant, i As Long
     arr = [a1].CurrentRegion.Value
        For i = 2 To UBound(arr)
             If arr(i, 4) <> "" Then
              arr(i, 3) = arr(i, 4)
              arr(i, 4) = ""
            End If
        Next
  [a1].CurrentRegion.Value = arr
End Sub

Thank you, RustmaMika. The code worked perfectly