code to go down a column and find the last cell with data before an empty cell

[Steve G]

I have about 135 sets of data in an Excel spreadsheet. Each data set
is a range of 4 rows by 8 columns. The cell in the first row and 1st
column is always empty. For each data set I am trying to put all of
the data in the first row in 31 columns. What is the code to go to
the last cell in a column that has data before an empty cell. I am
trying to create a range of 3 rows by 8 columns and move the data to
the first row. Then I want to create a range of 2 rows by 8 columns
and move the data to the first row. Then I want to create a range of
1 row by 8 columns and move the data to the first row. I need to do
this about 135 times. It takes me more than an hour to do this with a
macro. Since macros do not loop I would like to write a VBA program
to do this with one mouse click.

Any help would be greatly appreciated. This is my first VBA project
in Excel. I have one reference book--Programming in Excel 2000 with
VBA by John Walkenbach. I use Excel 2003.

Steve G

 

[OssieMac]

Hi Steve,

Contrary to your belief, macros can be made to loop. If I have interpreted
your needs correctly then the following will place each data set of 4 rows
onto one row. However, there are a few conditions.

Ensure that you make a backup copy of your workbook to run the macro in case
it does not do what you want.

Data needs to start at cell A1 with NO COLUMN HEADERS or any other data on
the worksheet. That is it should be in columns A to H. If it is not then copy
and move it so that it does commence at cell A1. (This should not be a
problem because after all it is only a copy of your workbook. Right!)

From your description I understand that the first row of each data set has
only 7 elements because the first cell is blank. The other 3 rows have 8
elements each. (31 in all).

The program places all the data to the right of the existing data. You can
delete the initial data when it is finished.

Because you say it is your first VBA project, I will include some more
instructions on getting the macro into the workbook.

Alt/F11 to open the VBA editor.
Click on Insert then Module.
Copy the macro and paste it into the VBA editor.
Edit the first actual code line of the macro so that your sheet name matches
the sheet name I have used. (Alternatively rename the worksheet where your
data is to match the macro.)
Change windows back to the worksheet.
Click on menu item Tools->Macro->Macros->Copy_Data->Run.

In the macro, I have included comments (They appear in green with a single
quote at the beginning of the line) to let you know what it is supposed to do.

Where you see a space and underscore ( _ ) at the end of a line, it means
that it is only a break in what is otherwise a single line of code.

Will appreciate it if you let me know how it goes.


Sub Copy_Data()

Dim lastCol As Integer 'Last column with initial data
Dim lastRow As Integer 'Last row with initial data
Dim dataRnge As Range 'Range of initial data
Dim colNumber As Integer
Dim rowNumber As Integer
Dim i As Integer 'Counter in loops
Dim j As Integer 'Counter in loop

'In the following line of code, replace the
'name 'Data Sheet' with the name of
'the sheet that contains your data.

Sheets("Data Sheet").Select

Application.ScreenUpdating = False

'Find last column of row 1 that contains data.
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

'Find last row that contains data
lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row

'Name the range for all existing data
Set dataRnge = Range(Cells(1, 1), Cells(lastRow, lastCol))

rowNumber = 1 'Increments for Output data

With dataRnge 'Initial data

For i = 1 To .Rows.Count Step 4

'Copy and paste 4 rows of data
For j = 0 To 3 'Each set of 4 rows of data

'Handle first cell of dataset which is blank
If j = 0 Then colNumber = 2 Else colNumber = 1

'Copy each row of data in turn
.Range(Cells(i + j, colNumber), _
Cells(i + j, 1 + 7)).Copy

'Select the last blank cell in required row
Cells(rowNumber, Columns.Count).End(xlToLeft) _
.Offset(0, 1).Select

'Paste the data
ActiveSheet.Paste
Next j

'Increment row for data output
rowNumber = rowNumber + 1

Next i

End With

Application.CutCopyMode = False
Cells.Columns.AutoFit
Cells(1, 1).Select
Application.ScreenUpdating = True

End Sub

Regards,

OssieMac