Macro to sort, format, sum, a dynamic set of data

F

Flipper

Good Day

I process a data that is extracted from a loan system through a data mining
app. I do as much formatting in that app as I can before expoting to excel.
I'm trying to write a macro that will do all the formatting I need. I can
actually record the macro to do exactly what I want, EXCEPT, there are
multiple ranges of data, that may be there one day, but not the next.
I really have very limited exp. with macros, other than recording, and I
just don't have a clue how to do this. Here is a portion of the code:

Sub FINX_FORMAT()
'
' FINX_FORMAT Macro

'

'

Columns("K:K").Select
Selection.Cut
Columns("P:p").Select
ActiveSheet.Paste
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
Range("A1").Select
Selection.End(xlDown).Select
Range("J23:N23").Select
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("K23").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-21]C:R[-1]C)"
Selection.AutoFill Destination:=Range("K23:N23"), Type:=xlFillDefault
Range("K23:N23").Select
Selection.End(xlToLeft).Select

I basically need to repeat this same steps over and over, again with the
understanding that the date will change from day to day.

I would so appreciate some assistance
 
P

PY & Associates

Good Day

I process a data that is extracted from a loan system through a data mining
app.  I do as much formatting in that app as I can before expoting to excel.  
I'm trying to write a macro that will do all the formatting I need. I can
actually record the macro to do exactly what I want, EXCEPT, there are
multiple ranges of data, that may be there one day, but not the next.  
I really have very limited exp. with macros, other than recording, and I
just don't have a clue how to do this.  Here is a portion of the code:

Sub FINX_FORMAT()
'
' FINX_FORMAT Macro

'

'

    Columns("K:K").Select
    Selection.Cut
    Columns("P:p").Select
    ActiveSheet.Paste
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("D2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
        :=xlSortNormal
    Range("A1").Select
    Selection.End(xlDown).Select
    Range("J23:N23").Select
    With Selection.Font
        .Name = "Tahoma"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("K23").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-21]C:R[-1]C)"
    Selection.AutoFill Destination:=Range("K23:N23"), Type:=xlFillDefault
    Range("K23:N23").Select
    Selection.End(xlToLeft).Select

I basically need to repeat this same steps over and over, again with the
understanding that the date will change from day to day.

I would so appreciate some assistance
Click to expand...

I guess you want to sum but the number of rows differ daily.
The sum should appear in the next available row.
You may test this if above is correct

Sub m()

Columns("P:p") = Columns("K:K").Value
Columns("K:K").Delete

Range("A1").CurrentRegion.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending,
Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal

lrow = Range("A1").CurrentRegion.Rows.Count
nrow = lrow + 1

Range(Cells(nrow, "J"), Cells(nrow, "N")).Select
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 10
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(nrow, "K").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & nrow - 1 & "]C:R[-1]C)"
Selection.AutoFill Destination:=Range(Cells(nrow, "K"),
Cells(nrow, "N")), Type:=xlFillDefault
Cells(nrow, "K").End(xlToLeft).Select

End Sub
 
M

Matthew Herbert

Flipper,

Without more context, I can't speak directly to how you need to repeat the
process knowing that "the date will change." If you have more details
regarding this, then feel free to explain more in detail, but without sample
data or more information it's hard to tell exactly what you are looking to
do. However, I tried to provided some sample code, along with comments, to
help in your understanding of VBA. The code is illustrative and NOT tested,
but it should condense a lot of what you listed in the post.

Best,

Matthew Herbert

Sub TestIt()
Dim rngCut As Range
Dim rngPaste As Range
Dim rngFormat As Range
Dim varArr As Variant

'The code and comments below are for illustrative purposes
' use F8 repeatedly to debug the code. You can split
' your Excel and VBE screens to watch what happens in
' Excel as you evaluate your code.

'VBA is an object-oriented language. You can create objects
' by using the Set statement. Once you have an object, then
' all of the properties, methods, and events are exposed to
' that object. Using objects prevents you from having to
' do .Select or .Activate because the object's identity (i.e.
' it's location is known and therefore does not need to be
' selected to be manipulated).
'
' For example, rngCut is created as a Range Object. A method
' of a Range Object is .Cut (which performs the cut operation).
' A property of a Range Object is .Column (which returns the
' column number for the Range Object).
Set rngCut = Columns("k:k")
Set rngPaste = Columns("p:p")

rngCut.Cut rngPaste
rngCut.Delete xlToLeft

'the four lines of code above can also be written as follows:
' Columns("k:k").Cut Columns("p:p")
' Columns("k:k").Delete xlToLeft

'sort the specified range
Range("A1").CurrentRegion.Sort Key1:=Range("H2"), Order1:=xlAscending, _
Key2:=Range("D2"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

'create a range object
Set rngFormat = Range("J23:N23")

'change the font settings for the range
' A With block basically "appends" the object to all the dot (".")
' operators.
' .Name = "Tahoma" is really rngFormat.Font.Name = "Tahoma"
' etc.
With rngFormat.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 10
.ColorIndex = 1
End With

'clear the diagonal borders
With rngFormat
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With

'create an array of border types. The xl... is an enumeration.
' If you search the under "Classes" in the Object Browser
' (View|Object Browser) for xlBordersIndex, you'll see the
' different border options. If, for example, you click on
' xlEdgeLeft, you'll notice the following: Const xlEdgeLeft = 7
' Enumerations are string text that correspond to a number.
' It's easier to remember or understand the string name
' than a number

'the Array function returns an array (type Variant). See the help
' file for "Array Function"
varArr = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight,
xlInsideVertical)

'ApplyBorderArray is a custom procedure that has two parameters
' (1) Rng (which is a range object) and varArr (which is a Variant)
' data type. See the procedure below for more details.
ApplyBorderArray rngFormat, varArr

'Another way to call ApplyBorderArray without needing to use
' a variable for the varArr parameter
'ApplyBorderArray rngFormat, Array(xlEdgeLeft, xlEdgeTop, _
xlEdgeBottom, xlEdgeRight, xlInsideVertical)

'Another illustration of a procedure that does the same thing
' as ApplyBorderArray
ApplyBorder rngFormat, xlEdgeLeft
ApplyBorder rngFormat, xlEdgeTop
ApplyBorder rngFormat, xlEdgeBottom
ApplyBorder rngFormat, xlEdgeRight
ApplyBorder rngFormat, xlInsideVertical

'ActiveCell.FormulaR1C1 = "=SUM(R[-21]C:R[-1]C)"
' You don't have to use R1C1 notation, you can use A1 notation
Range("K23").Formula = "=SUM(K2:K22)"

'AutoFill Destination:=Range("K23:N23"), Type:=xlFillDefault
' You can specify the fill directly
Range("K23:N23").FillRight

End Sub

Private Sub ApplyBorder(Rng As Range, lngBorder As XlBordersIndex)

'enumerations have a Long data type

'apply the border, specified by lngBorder, to Rng
With Rng.Borders(lngBorder)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End Sub

Private Sub ApplyBorderArray(Rng As Range, varArr As Variant)

Dim varItem As Variant

'Rng is the range that you want to apply the Border settings to

'varArr is an array of XlBordersIndex constants (which are
' numbers with a Long data type)

'loop through each item in varArr, and apply the border below
' to Rng
For Each varItem In varArr
With Rng.Borders(varItem)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next varItem

End Sub

Flipper said:
Good Day

I process a data that is extracted from a loan system through a data mining
app. I do as much formatting in that app as I can before expoting to excel.
I'm trying to write a macro that will do all the formatting I need. I can
actually record the macro to do exactly what I want, EXCEPT, there are
multiple ranges of data, that may be there one day, but not the next.
I really have very limited exp. with macros, other than recording, and I
just don't have a clue how to do this. Here is a portion of the code:

Sub FINX_FORMAT()
'
' FINX_FORMAT Macro

'

'

Columns("K:K").Select
Selection.Cut
Columns("P:p").Select
ActiveSheet.Paste
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
Range("A1").Select
Selection.End(xlDown).Select
Range("J23:N23").Select
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("K23").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-21]C:R[-1]C)"
Selection.AutoFill Destination:=Range("K23:N23"), Type:=xlFillDefault
Range("K23:N23").Select
Selection.End(xlToLeft).Select

I basically need to repeat this same steps over and over, again with the
understanding that the date will change from day to day.

I would so appreciate some assistance
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Hlp! Adv Filter - Non-Contiguous rows don't copy 11
How to rewrite this code? (Second half) 1
Loops through Sheets but doesn't work. 5
Help with macro 1
Formatting stop when reach blank cell 6
Page Break???????? 11
How to rewrite this code? (first half) 1
Simplify 1

Top