Excel macro to move data then delete rows

[Oglesbay]

Hello all. I am an Excel expert, but I've never had to do VBA coding in macro's, so I guess I'm not too much of an expert then!

The issue I have is I have a report that looks something like this:

Class Name
Instructor
Class Date

Class Name
Instructor
Class Date


And this repeats for 1500 rows. Basiclly I need a macro that will take the instructor and class date (which is always in the same location in reference to the class name) and class date and move them to the same row, then delete the 5 rows between the two class names, and repeat until there is no more data.

Does this make sense? Basically the report should look like this when done.

Class Name Instructor Class Date
Class Name Instructor Class Date


Any help would be greatly apprecitated!

 

[Andrzejek]

You don't want to tell us that you have a Report with 1500 rows that look like this:

Class Name Instructor Class Date
Class Name Instructor Class Date
Class Name Instructor Class Date
Class Name Instructor Class Date
Class Name Instructor Class Date
Class Name Instructor Class Date
Class Name Instructor Class Date
Class Name Instructor Class Date
........

You HAVE to have another data in it, right?
If so, what other data do you have in this Excel file?

Have fun.

---- Andy

 

[Oglesbay]

This is an Excel report that shows all the courses that have been taught in a 5 month period. It was exported (only options are HTML and EXL) out of a seperate applicaion which is why it looks the way it does. I'm trying to get it cleaned up so I can run totals, charts and all that other good stuff.

Yes, there is a little more data but not much more. But why would I HAVE to have more data? If that is what was I was given,then that's what I have.

 

[Oglesbay]

And to clarify, the data fields aren't really "Class Name", "Instructor", and "Class Date." There are real fields in there and I just simplified what I was trying to show.

 

[kray4660]

Here is a crude but workable code. It is a start if nothing else.

Sub combinedata()
Worksheets("Sheet1").Activate
Cells(1, 2) = Cells(2, 2)
Cells(2, 2) = ""
Cells(1, 3) = Cells(3, 3)
Cells(3, 3) = ""
j = 2
For i = 6 To 1500 Step 6
Cells(j, 1) = Cells(i, 1)
Cells(i, 1) = ""
Cells(j, 2) = Cells(i + 1, 2)
Cells(i + 1, 2) = ""
Cells(j, 3) = Cells(i + 2, 3)
Cells(i + 2, 3) = ""
j = j + 1
Next i
End Sub

 

[Andrzejek]

After I sent the responce, I thought that the info was just an example, and the data looked something like:
[tt]
ComS 212 J. Smith 01/01/2010
Soc 101 M. Brown 02/01/2010
Math 200 C. James 03/03/2010
.....[/tt]

Sorry for the missunderstanding... :-(

And if kray4660's code works (I hope it does) I would do my Deleting the rows from the buttom - up

Have fun.

---- Andy

 

[SkipVought]

hi,

If this is a ONE SHOT DEAL, I'd simply use ans IF() statement for each column to propagate the data.

If not then

    Dim r1 As Range, r2 As Range
    
    With ActiveSheet.UsedRange
        Set r1 = .Cells(1, 1)
        Set r2 = r1.End(xlDown).Offset(-1)
        Do While r1.Column <= .Column + .Columns.Count - 1
            Do While r2.Row <= .Row + .Rows.Count - 1
                Range(r1, r2).Value = r1.Value
                Set r1 = r2.Offset(1)
                Set r2 = r1.End(xlDown).Offset(-1)
            Loop
            If r1.Row < .Row + .Rows.Count - 1 Then _
                Range(r1, .Cells(.Rows.Count, 1)).Value = r1.Value
            Set r1 = Cells(1, r1.Column + 1).End(xlDown)
            Set r2 = r1.End(xlDown).Offset(-1)
        Loop
    End With

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

sorry, I missed some of my code

    Dim r1 As Range, r2 As Range
    
    With ActiveSheet.UsedRange
        Set r1 = .Cells(1, 1)
        Set r2 = r1.End(xlDown).Offset(-1)
        Do While r1.Column <= .Column + .Columns.Count - 2
            Do While r2.Row <= .Row + .Rows.Count - 1
                Range(r1, r2).Value = r1.Value
                Set r1 = r2.Offset(1)
                Set r2 = r1.End(xlDown).Offset(-1)
            Loop
            If r1.Row < .Row + .Rows.Count - 1 Then _
                Range(r1, .Cells(.Rows.Count, r1.Column)).Value = r1.Value
            Set r1 = Cells(1, r1.Column + 1).End(xlDown)
            Set r2 = r1.End(xlDown).Offset(-1)
        Loop
        .Cells(1, 1).AutoFilter
        .Cells(1, 1).AutoFilter Field:=.Columns.Count, Criteria1:="="
        
        Application.DisplayAlerts = False
        .Cells.Delete
        Application.DisplayAlerts = True
    End With

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Gavona]

If one shot then I would manually do the following:

Sub Macro1()
With Range("A2:B13").SpecialCells(xlCellTypeBlanks)
    .FormulaR1C1 = "=R[-1]C"
    .Value = .Value
    .CurrentRegion.AutoFilter Field:=3, Criteria1:="="
    .CurrentRegion.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub

Select first two columns of range
Edit, goto, Special, blanks
={up-arrow} {Ctrl}-{Enter}
Select first two columns, copy, PasteSpecial,values
Filter third column for blanks
Select and Delete those entire rows


Gavin

 

[Gavona]

With 300 non-contiguous groups of rows to delete my code (and Skip's) may take a little while at the delete stage. If this is an issue then sort your entire table before doing the autofilter and delete bits. If the order of the rows is important you can of course record the current order in a helper column and re-sort by that column after the delete.

Gavin