?
Solved

Formatting an Excel document after creation with VBA

Posted on 2011-04-22
5
Medium Priority
?
287 Views
Last Modified: 2012-05-11
Hi

I am using Excel for creating offers and bills.
I'm really fast at it, too. But one thing is kind of tedious.

I have a formatting requirement:
Between each row that has text, there should be one row, and only one, that is empty.
The height of the row should be 15.

Unfortunately, I do not know how to keep the number of empty rows constant.
What's more, the empty rows should have the same height.

So, after creating the document, I would like to run a macro that makes sure that
1) omitted rows are inserted,
2) single empty rows with the wrong height adjusted, and
3) double or triple rows that are empty deleted.

So here's what I desire:

Here's sth bold
Here's an empty row. Height: 15
Here's some text
Here's an empty row. Height: 15
Here's some more text
Here's an empty row. Height: 15

What I may have is something like this:
Here's sth bold
Here's an empty row. Height: 30
Here's an empty row. Height: 15
Here's some text
Here's some more text
Here's an empty row. Height: 40

Is it possible to create a macro for this?
I know only some VBA and mostly from code that I got with the macro recorder and adapted.

Thanks!
Screenshot---18.04.2011---18-24-.png
0
Comment
Question by:speechrec
  • 2
  • 2
5 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35449865
>>s it possible to create a macro for this?
I know only some VBA and mostly from code that I got with the macro recorder and adapted.

Yes :)

If you can upload the file I will directly write a macro for that. That way, I'll get my references correct as well in one go :)

Sid
0
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 2000 total points
ID: 35449938
Try this macro
Sub altemptyrows()
For Each rw In ActiveSheet.UsedRange.Rows
If rw.Row > 1 And rw.Row < ActiveSheet.UsedRange.Rows.Count Then
    If WorksheetFunction.CountA(rw) = 0 Then
        Do While WorksheetFunction.CountA(rw.Offset(1, 0)) = 0
            rw.Offset(1, 0).Delete
            If WorksheetFunction.CountA(Range(Cells(rw.Row + 1, 1), Cells(ActiveSheet.Rows.Count, ActiveSheet.Columns.Count))) = 0 Then Exit Do
        Loop
            rw.RowHeight = 15
    Else
        If WorksheetFunction.CountA(rw.Offset(-1, 0)) > 0 Then
            rw.Insert
            rw.Offset(-1, 0).RowHeight = 15
        End If
    End If
End If
Next rw
End Sub

Open in new window

0
 

Author Comment

by:speechrec
ID: 35450128
ssagibh
This is quite good.
Is there any way to stop it after line 200?
I never go further than that at it doesn't need to loop all the way through.
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 35450335
Change

If rw.Row > 1 And rw.Row < ActiveSheet.UsedRange.Rows.Count Then

to

If rw.Row > 1 And rw.Row < 200 Then
0
 

Author Comment

by:speechrec
ID: 35450472
Thanks, that was it!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question