[RESOLVED] Automate Some Cell Formatting in Excel 2002
I have a spreadsheet that contains two identical sheets with headings like this
Row 2 is formatted as Custom 'dd' and cell C2 has the formula '1+B2'. Cell D2 has the formula '1+C2', etcetera out to cell AQ2 which has the formula 1+AP2 and so back on December 20 I put '12/20/2011' in cell B2 which generated the values in the rest of the row.
Cell B3 has the formula =LEFT(TEXT(B2,"ddd"),1), and C3 has the formula =LEFT(TEXT(C2,"ddd"),1), etcetera so the letters for the days are automatically generated when I put the current date in cell B2.
I normally generate new sheets when the days reach the end of the chart so on the 31st of January I should have done the following to produce new sheets. (I'm a few days behind).
Select the merged cell that contains 'Dec-11' and Format|Cells|Alignment and uncheck 'Merge cells'. Do the same for the merged cell that contains 'Jan-12' and if there had been a 3rd merged cell as there sometimes is, do the same for it.
Remove the dates that remain in row 1 from the 2 (or 3) cells.
The cells that separated the months (N1, N2 and N3) are formatted so that their left side has a dark border and I would remove that by selecting, say, cells P1, 2 and 3, and Copy|Paste Special|Formats to N1, 2 and 3. I would do the same for the second set of month separating cells if there was one.
I would then put the current date (or in this case since I'm behind, 1/31/2011) in cell B2 to generate the new day numbers and letters resulting in this.
January is a one-column (column B) month this time so let's ignore it for a minute. I would then select cells C1:AD1 that represent February and Format|Cells|Alignment and check 'Merge cells' and enter '02/2012' which would be changed to 'Feb-12' because the row is formatted as Date of type 'Mar-01'. I'd do the same for cells AE1:AQ1 and enter '03/2012'. Since cell B1 which represents January is too small to hold 'Jan-11' I would just enter a 'J'.
Then I would select cells C1:C3 and select the 'Left border' icon from the 'Borders' menu and do the same for AE1:AE3 giving me this
Finally I would copy rows 1, 2 and 3 from Sheet1 to Sheet2.
I'd be very grateful if someone could show me the code for a button (at, say, column C, row 40 on sheet1) that would request the starting date (default of current date), put that date in cell B2 and then do steps 1 through 7.
Last edited by MartinLiss; Feb 1st, 2012 at 01:52 PM.
I know I'm fighting the setting, however without the merging of the cells in row 1 for each month you could do the rest (which is just the msarking of the cell where a new month starts) by using a conditional formating. The Rule would look like this
Code:
=MONTH(A$2)<>MONTH(B$2)
It should be used for all cells (in Row 1 to 3) except the one in Column 1.
I'll keep the line problem in mind, just give me some time on that one.
Would you take the entry in line1 if the month would be displayed above day 01 of the month?
I do like to do some coding in VBA, but why do coding when Excel does it by its own formulas!
You're welcome to rate this post!
If your problem is solved, please use the Mark thread as resolved button
I know I'm fighting the setting, however without the merging of the cells in row 1 for each month you could do the rest (which is just the msarking of the cell where a new month starts) by using a conditional formating. The Rule would look like this
Code:
=MONTH(A$2)<>MONTH(B$2)
It should be used for all cells (in Row 1 to 3) except the one in Column 1.
I'll keep the line problem in mind, just give me some time on that one.
Would you take the entry in line1 if the month would be displayed above day 01 of the month?
I do like to do some coding in VBA, but why do coding when Excel does it by its own formulas!
Thanks but I really want to keep the formatting (merged cells, and the left, dark, border of the cells which transition to a new month).
Did you mean =MONTH(B$2)<>MONTH(C$2) rather than =MONTH(A$2)<>MONTH(B$2) since column 'A' isn't involved with this? In any case I don't understand what that would do. And when you talk about "displayed above day 01 of the month", it is, it's just that the cells are merged so the 'Feb-12' etcetera is automatically centered.
feb 12 has 29
the rest is more or less straight forward, most of the steps can be done recording a macro, which can be used in a procedure
step 1 can be skipped if a new blank sheet is added
i will try to do some of this later, no time now
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
feb 12 has 29
the rest is more or less straight forward, most of the steps can be done recording a macro, which can be used in a procedure
step 1 can be skipped if a new blank sheet is added
i will try to do some of this later, no time now
You're right about Feb 29th. I'm very surprised that the Excel formula =1+AD2 that's in AE2 didn't pick that up!
As for a macro, yes, I thought about that but wouldn't that work only if the chart were the same each time I updated it?
Public Sub ShowMonthAndYear()
'Will erase the old entries in Row1 and
'will display updated Month and Year in merged cells on top of each month
Range("1:1").MergeCells = False
Dim CurCol As Integer
Dim StartMonth As Integer 'First Column for this Month
Dim EndMonth As Integer 'Last Column for this Month
CurCol = 2
'find first and lat Column for the month
With ThisWorkbook.ActiveSheet
StartMonth = CurCol
Do
CurCol = CurCol + 1
If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Then
EndMonth = CurCol - 1
.Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
.Cells(1, StartMonth) = .Cells(2, StartMonth)
StartMonth = CurCol
End If
Loop Until CurCol = 41 'Ends at AQ!
End With
End Sub
All you would need to do is format the Row to display Centered and only show Month and Year.
And for the Conditional Formula, you are correct, I used Column A in my working example which you don't do.
If you need my example worksheet just tell.
You're welcome to rate this post!
If your problem is solved, please use the Mark thread as resolved button
I selected the first two rows of my sheet, cleared them and then executed your code. I had to remove the lines 12, 56 and 57 because they gave me 'Object does not support this property or method' errors. After doing that it gave back essentailly two blank rows. How should I test it?
Sorry for those three lines, I didn't expect them not to run in your Excel-Version. All they do is remove or set a color filing for Row2.
The macro should run on the current WorkSheet, which I assumed to formated in Row2 and Row3 as stated in your post #1.
I'll put my working-file into this reply.
Will close down for tonigth (it'S 11:30 PM in here) will look after that first thing tomorrow.
You're welcome to rate this post!
If your problem is solved, please use the Mark thread as resolved button
Here is what your post #11 code gave me. And when I asked "how should I test it" I was asking if I need to anything on an old sheet before clicking the button?
No action is needed besides having the Sheet with the correct ly formatted rows 2and 3 open, however I saw that I missed your Step 7(copy rows 1 to 3 to another Sheet). Sorry, that will have to wait until tommorrow.
You're welcome to rate this post!
If your problem is solved, please use the Mark thread as resolved button
I realized that I was testing your code on a very old sheet that didn't have my current formatting and once I corrected that your code worked almost perfectly; thank you!
The problems I found were that
o It didn't ask for a starting date - I corrected that
o It removed the formatting (the gray color) in cells A1 and AR1 - I corrected that
o It doesn't do anything about 'narrow' months (like the one column for January
o It doesn't copy to sheet2
I'm going to work on those last two and see what I can do.
I've done very little Office coding previously and I'm wondering what the best way is to save code changes without saving the sheet?
Okay I just can't figure out how to handle 'narrow' months.
Ideally I'd like the code to follow this pseudocode
Code:
If text of the month (like 'Jan-12') doesn't fit in the columns or column Then
Change text to 'Jan'
If that text still doesn't fit Then
Change text to 'J'
End If
End If
I'd settle however for always using the first letter of the month if the full text doesn't fit. Or if the 'doesn't fit' part is difficult to determine then if there are 3 or less columns involved the use the first letter.
Note that the too narrow situation could occur either with the first month or the last month.
Here's my current code on Sheet1:
Code:
Private Sub CommandButton1_Click()
Dim StrDate As String
StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)
Application.DisplayAlerts = False
'Clear old Data and Format
With ThisWorkbook.ActiveSheet
.Range("1:1").MergeCells = False
.Range("B1:AQ1").Clear
.Range("1:3").Borders(xlEdgeLeft).LineStyle = xlNone
.Range("1:3").Borders(xlEdgeTop).LineStyle = xlNone
.Range("B1:AQ1").Borders(xlEdgeBottom).LineStyle = 1
.Range("1:3").Borders(xlInsideHorizontal).LineStyle = xlNone
.Range("1:3").Borders(xlInsideVertical).LineStyle = xlNone
' Put start date in B2
.Cells(2, 2) = StrDate
'Do the new formatting and fill in new Data
Dim CurCol As Integer
Dim StartMonth As Integer 'First Column for this Month
Dim EndMonth As Integer 'Last Column for this Month
CurCol = 2
With Range("B1:B3")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
End With
'find first and last Column for the month
StartMonth = CurCol
Do
CurCol = CurCol + 1
If Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth)) Or CurCol = 43 Then 'Last Column is 43=AQ!
If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
EndMonth = 43
Else
EndMonth = CurCol - 1
End If
If Not StartMonth = EndMonth Then
.Range(.Cells(1, StartMonth), .Cells(1, EndMonth)).MergeCells = True
.Cells(1, StartMonth) = .Cells(2, StartMonth)
End If
If CurCol = 43 And Not (Month(.Cells(2, CurCol)) <> Month(.Cells(2, StartMonth))) Then
StartMonth = CurCol + 1
Else
StartMonth = CurCol
End If
.Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range(.Cells(1, StartMonth), .Cells(3, StartMonth)).Borders(xlEdgeLeft).Weight = xlThin
End If
Loop Until CurCol = 43
End With
Range("1:1").NumberFormat = " mmm-yy"
Range("1:1").HorizontalAlignment = xlCenter
With Range("B2:AQ2")
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Interior.Pattern = xlSolid
End With
' Copy rows 1 to 3 to sheet "Sheet2"
ThisWorkbook.ActiveSheet.Rows("1:3").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Rows("1:3").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub
1.IMHO your code doesn't get the date correctly as a date, it uses just the String, I changed that.
2. Narrow Month will display either only the 3-Letter Month (2 Cells) or just the first Letter of the month (1 Cell).
3. You do the copy on the hardcoded SheetName "Sheet2", you need to make sure that such a Sheet always exists! The same is true for "Sheet1" to which you are jumping back.
I hope everything is fixed now.
VBA Code:
Public Sub UpDateCalender()
Dim StrDate
StrDate = InputBox("Please enter starting date 'MM/DD/YYYY", "Chart Starting Date", Date)
Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002
Marty
I was beating my head against the wall with this
last night, and it looks like I'm too late .. Opus has
presented a solution and you've marked this RESOLVED.
Nonetheless, I finally got my alternate solution working
(mostly), and thought I'd include the pertinent code
snippet. The key feature is that it uses an array.
Code:
' 2.1. Put start date in B2
.Cells(2, 2) = StrDate
' 2.2. Row 1 -- MMM-YY
Dim pMon, cMon
Dim aTXT(3, 4)
' aTXT(ee, 1) = beg col
' aTXT(ee, 2) = end col
' aTXT(ee, 3) = width
' aTXT(ee, 4) = raw text formatted mmm-yy
ee = 1
aTXT(1, 1) = 2
pMon = Month(StrDate)
' 2.3. fill array
For cc = 2 To 43
cMon = Month(.Cells(2, cc))
' new month
If cMon > pMon Then
pMon = cMon
ee = ee + 1
aTXT(ee, 1) = cc
End If
' update
aTXT(ee, 2) = cc
aTXT(ee, 3) = aTXT(ee, 2) - aTXT(ee, 1) + 1
aTXT(ee, 4) = Format(.Cells(2, cc), "mmm-yy")
Next cc
' 2.4. post
For ii = 1 To 3
bb = aTXT(ii, 1)
ee = aTXT(ii, 2)
wid = aTXT(ii, 3)
raw = aTXT(ii, 4)
' truncate as req'd
If wid = 1 Then
txt = Left(raw, 1)
ElseIf wid = 2 Then
txt = Left(raw, 3)
Else
txt = raw
End If
' post
.Cells(1, bb).NumberFormat = "@"
.Cells(1, bb) = txt
.Range(.Cells(1, bb), .Cells(1, ee)).merge (across)
Next ii
Some comments
Text manipulation .. if StrDate is ..
1/31/2012 .. J .. Feb-12 .. Mar-12 ....... << 1 col wide at left
1/30/2012 .. Jan .. Feb-12 .. Mar-12 .... << 2 cols wide at left
2/19/2012 .. Feb-12 .. Mar-12 .. Apr .... << 2 cols wide at col 42
2/20/2012 .. Feb-12 .. Mar-12 .. A ....... << 1 col wide at col 43
Merging and Lines
I got it to merge, but not centered
I did not deal with the lines
FWIW, you need to check more than the left side .. in
rare cases, you may end up with a width of only 1 or 2
at the right side as well. I emphasize that just in case
that situation was overlooked.
Re: [RESOLVED] Automate Some Cell Formatting in Excel 2002
Spoo I hope your head doesn't hurt to much Seriously, thanks for the effort but I'm going to stick with Opus' method. I mentioned a few posts back that the 'narrow month' problem could occur at either end of the chart but I didn't test the right side. It turns out that Opus' code works when there is two columns there but not when there's just one. Don't worry about that (either of you); I can handle it.