VBA Excel 2000 - Identify and select Ranges

Dear Experts,

Could you please check the attached small file on Sheet1, it contains just some cells in use, the others are blank.

Do you have idea maybe for a logic, which would check the whole sheet, and as result would identify the first and last cells of such "Blocks".

In the example I would mean on "Blocks" the

1) A1 first cell and last C10
2) E1 to H17
3) J1 to K6

As final target I would like to select the first block of data, around with ActiveSheet.Range(Cells(1, 1), Cells(10, 3)).Select, format and putting totals under of it, after going to the second etc. Just for this would need to know always, that actually which is the last cell of the block, because those can change. I did it manually in the file on Target sheet.


csehzIT consultantAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

TracyConnect With a Mentor VBA DeveloperCommented:
This one is a little better and it adds in the borders too.
Eric ZwiekhorstSAP Business ConsultantCommented:
Dear csehz,

if I understand correct.

You look from  Column A to the first Column with a blank.
There one  Column back you calculate the sum of that column and put it underneath whith total left of that range Total, than you want to mark this range with the borders and the total line coloured yellow.
This should be repeated as asmany groups you can detect.

is always in row 1 a blank as seperation between groups?

Kind regards

csehzIT consultantAuthor Commented:
Hi Eric,

exactly and yes that is sure that always one empty column is between of these groups

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

TracyVBA DeveloperCommented:
Try this:
Sub CalculateTotals()

    tempcol = 1 'Start at column 1
    lastcol = Range(Cells(1, Columns.Count), Cells(1, Columns.Count)).End(xlToLeft).Column 'Get the very last column with data
    mycounter = WorksheetFunction.CountBlank(Range(Cells(1, 1), Cells(1, lastcol))) + 1 'Count how many blanks there are
    For i = 1 To mycounter
        lastcol = Range(Cells(1, tempcol), Cells(1, tempcol)).End(xlToRight).Column
        lastRow = Range(Cells(Rows.Count, lastcol), Cells(Rows.Count, lastcol)).End(xlUp).Row
        'Add Total and Value
        Cells(lastRow + 1, tempcol).Value = "Total"
        Cells(lastRow + 1, lastcol).Value = WorksheetFunction.Sum(Range(Cells(1, lastcol), Cells(lastRow, lastcol)))
        'Add Highlighting
        Range(Cells(lastRow + 1, tempcol), Cells(lastRow + 1, lastcol)).Interior.ColorIndex = 36
        Range(Cells(lastRow + 1, tempcol), Cells(lastRow + 1, lastcol)).Interior.Pattern = xlSolid
        tempcol = lastcol + 2

End Sub

Open in new window

Eric ZwiekhorstConnect With a Mentor SAP Business ConsultantCommented:
dear all,
maybe a little late but here is my version to..
csehzIT consultantAuthor Commented:
Sorry I had the chance to check only now, both macros are working..

You are fantastic to solve this, I will apply on my live examples. Thanks very much
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.