PDA

View Full Version : formatting macro in VBA



keilah
08-31-2007, 06:16 AM
Hi - experts

Need help on the following macro.......i'll outline the steps that i need the macro to do.....i am trying to work it out also so.....no code yet.....
steps

1. Sort column H (starting at row 7) in descending date order and also at the same time sort all other column FROM column D:IA to be in order according to date.

2. Arrange columns G:IA (starting at row 7 in each column) in date order starting at 01/2000 to current if there is a date in 01/2000, or the most oldest date to date.....i hope this makes sense.

3. Add "-" as a zero value to all rows that are empty in the range column J:CG and rows 8:1698.......and also change all cells that have a "0" in them to "-".

4. Change all negitive number to red and in brackets in the same data range as point 3 and to (2 decmial places).

5. Format data in column I:CG (rows 8: 1698) in format 1,000.00 (2 decemial places).

mdmackillop
08-31-2007, 12:05 PM
Hi Keilah
For a problem such as this, please submit a sample workbook with your code to date and on which we can test solutions.
Regards
MD

keilah
09-02-2007, 02:48 PM
hi i'll post the spreadsheet tomorrow...thanks for the feedback..

keilah
09-03-2007, 12:08 AM
Hi All

Here is the spreadsheet....for the above formatting macro..................Any question please ask.

keilah
09-03-2007, 03:59 AM
Hi I am stuck on this one....any help.....

rbrhodes
09-03-2007, 05:04 AM
Hi keilah,

Try this on a COPY of your workbook.

BTW your example had a bad date at AU7 it was 4/200 so I put in an errorhandler for that.

This is not what i consider finished (and more work than a freebie) but try it out for sure!




Option Explicit
Sub FormatMacro()
'
'rbrhodes for VBAExpress Sept 2 2007
'
'http://www.members.shaw.ca/excelVBA
'
'
Dim c As Range
Dim rng As Range
Dim eMsg As Long
Dim sBar As Boolean
Dim LastCol As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim firstaddress As String
On Error GoTo endo

'//Change sheet name to suit
Set ws = Sheets("Sheet1")
'//end change
'//speed
With Application
sBar = .DisplayStatusBar
.DisplayStatusBar = True
.ScreenUpdating = False
End With

'//work with object
With ws
'//get last row of data Col D
LastRow = .Range("D65536").End(xlUp).Row
'//get last Col of data Row 7
LastCol = .Range("IV7").End(xlToLeft).Column
'//convert Columns J to Last Col to dates
Set rng = .Range(Cells(7, "J").Address, Cells(7, LastCol).Address)
'//bad data//
Err.Clear
On Error Resume Next

'//display
Application.StatusBar = "Formatting Date Columns..."

For Each c In rng
With c
.Value = DateSerial(Year(c), Month(c), 1)
If Err <> 0 Then
eMsg = MsgBox("Bad date at " & c.Address(0, 0) _
& vbCrLf & vbCrLf & " Aborting Sub", vbCritical)
Application.ScreenUpdating = True
ActiveSheet.ScrollColumn = c.Column
c.Select
GoTo BadDate
End If
.NumberFormat = "m/yyyy"
End With
Next c
On Error GoTo endo
'//end bad data//

'//display
Application.StatusBar = "Sorting..."

'//sort on Col H = dates 'descending'
.Range(Cells(8, 4).Address, Cells(LastRow, LastCol).Address).Sort _
Key1:=Range("H8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'//create range object
Set rng = .Range("I8:CG" & LastRow)

'//display
Application.StatusBar = "Replacing blanks and Zeros..."

'//replace "" and 0 with "-"
With rng
.Replace What:="", Replacement:="-", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="0", Replacement:="-", lookat:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False
'//set format
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

'//display
Application.StatusBar = "Formatting..."

'//OPTIONAL: align "-" to center//
Set c = .Find("-", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Application.StatusBar = "Formatting..."
c.HorizontalAlignment = xlCenter
Set c = .FindNext(c)
Application.StatusBar = "Formatting ..."
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
'//END OPTIONAL//
End With
'//display
Application.StatusBar = "Sorting Date Columns..."
'//sort Columns J to Last Col by date
Set rng = .Range(Cells(7, "J").Address, Cells(LastRow, LastCol).Address)
rng.Sort Key1:=Range("J7"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
End With

BadDate:
'//cleanup
Set c = Nothing
Set ws = Nothing
Set rng = Nothing

'//reset
With Application
.StatusBar = False
.ScreenUpdating = True
.DisplayStatusBar = sBar
End With
'//normal exit
Exit Sub
'//errored out
endo:
'//cleanup
Set c = Nothing
Set ws = Nothing
Set rng = Nothing

eMsg = MsgBox(Err.Number & " " & Err.Description, vbCritical)

'//reset
With Application
.StatusBar = False
.ScreenUpdating = True
.DisplayStatusBar = sBar
End With

End Sub

keilah
09-03-2007, 05:10 AM
Thanks mate

for the usefull feed back.....i am learning slowly but fast for you Gurus out there....Once again thanks..

RV6555
09-03-2007, 07:01 AM
Keilah, you might have a look at the knowledge base: http://vbaexpress.com/kb/getarticle.php?kb_id=90 (http://vbaexpress.com/kb/getarticle.php?kb_id=90)