1

I am trying to create a program that deletes all rows without information in columns B-G and then rearranges the data from a vertical orientation to a horizontal one.

The data is only in columns A-G arranged so that every couple rows (the number is not constant), a row of dates appears. I want every row with dates to be pasted horizontally from each other and all of the data in between the dates to move corresponding with their dates (including column A).

The part that deletes empty rows works well. However, as I tried to write the rearrangement program, I kept on getting an

"Object Required"

error that appeared in the sub line (AKA the first line). Can someone help me resolve this issue? The code is pasted below. 

Sub MovingDeletion()


Set rngRange = Selection.CurrentRegion
lngNumRows = rngRange.Rows.Count
lngFirstRow = rngRange.Row
lngLastRow = lngFirstRow + lngNumRows - 1

columns("B").Select
lngCompareColumn1 = ActiveCell.Column
columns("C").Select
lngCompareColumn2 = ActiveCell.Column
columns("D").Select
lngCompareColumn3 = ActiveCell.Column
columns("E").Select
lngCompareColumn4 = ActiveCell.Column
columns("F").Select
lngCompareColumn5 = ActiveCell.Column
columns("G").Select
lngCompareColumn6 = ActiveCell.Column

columns("A").Select
lngCompareColumn7 = ActiveCell.Column
Set MedicationRow = 0
'Deletion Code (Works  Fine)
For lngCurrentRow = lngLastRow To lngFirstRow Step -1
Mrow = True
If (Cells(lngCurrentRow, lngCompareColumn1).Text = "" And Cells(lngCurrentRow, lngCompareColumn2).Text = "" And Cells(lngCurrentRow, lngCompareColumn3).Text = "" And Cells(lngCurrentRow, lngCompareColumn4).Text = "" And Cells(lngCurrentRow, lngCompareColumn5).Text = "" And Cells(lngCurrentRow, lngCompareColumn6).Text = "") Then _
Rows(lngCurrentRow).Delete

'Rearrangement Code (Does not  work. Gives Object Requiered error)

Dim counter As Integer
Dim NextRow  As Integer
Dim i As Integer
i = lngCurrentRow
 counter = 0
 Number = 0
 If (Cells(lngCurrentRow, lngCompareColumn7).Text <> "Days") Then
   counter = counter + 1
   If counter > 1 Then
    NextRow = lngCurrentRow - 1
    While (Cells(NextRow, lngCompareColumn7).Text <> "Days")
     NextRow = NextRow - 1
     Number = Number + 1
     Wend
     End If
   Range("A" & CStr(i) & ":G" & CStr(NextRow)).Cut Range("H1" & CStr(i) & ":P" & CStr(NextRow))
  End If

Next lngCurrentRow

End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
Hunter Smith
  • 11
  • 1
  • 1
    Working with Select/Activate is not a good proctise in VBA and can make your code brittle and difficult to debug. See - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – Tim Williams Apr 19 '20 at 20:41
  • `Range("H1" & CStr(i) & ":P" & CStr(NextRow))` looks wrong. It may well end up being a different shape to the range that you have just cut (both the columns and rows won't match) – barrowc Apr 19 '20 at 21:50

0 Answers0