Logo 
Search:

MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Writing Macro wanted Tips

  Asked By: Kent    Date: Nov 01    Category: MS Office    Views: 1140
  

I have to write a macro for a excel sheet which is having huge amount of data.

It has several columns. InvoiceNo, Amount

InvoiceNo Amount
1 100
1 200
1 240
1 300
1 240
3 400
3 230
3 300
2 100

Now what I want to do is I want to add a third column called total which will
walk through all the InvoicesNo column and add up all the respective Amount and
show it in the total column something like this.

InvoiceNo Amount Total
1 100
1 200
1 240
1 300
1 240 1080
3 400
3 230
3 300 930
2 100 100


Share: 

 

7 Answers Found

 
Answer #1    Answered By: Feodora Bonkob     Answered On: Nov 01

No macro's! Just sort your input on InvoiceNo and insert subtotals on every
change of InvoiceNo. You can find the function under Data/Subtotals

 
Answer #2    Answered By: Della Simpson     Answered On: Nov 01

But my problem is slightly different.
Let me explain it.
See there is a Macro already written which is connecting to the
Database to run a function returning a Recordset. Using this
RecordSet the excel  is populated with columns  as Headings and some
columns has some formulas written.
Now after all this is done I want to call a function which will add
a column called total and display the records as shown in my earlier
post. I will have to select the columns name , range and create a
formula for TotAmount.

 
Answer #3    Answered By: Devrim Yilmaz     Answered On: Nov 01

Whilst a macro  could certainly be written to do this, there are 3 other
techniques, none of them needing VBA, which you ought to consider first,
particularly since these will do what the VBA you seek will not, which
is react to additional data  input.

The first and potentially most flexible and quickest is to create a
pivot table and there are many web guides to doing this if you've never
done it.

The second and third are to use array formulae or D-functions; if you
have a lot of data I'd recommend the latter. I have articles on how to
use these here:

http://www.grbps.com/Excel5.pdf (array formulae)
http://www.grbps.com/Excel3.pdf (D-functions)

 
Answer #4    Answered By: Ella Brown     Answered On: Nov 01

But my problem is slightly different.
Let me explain it.
See there is a Macro already written which is connecting to the
Database to run a function returning a Recordset. Using this
RecordSet the excel  is populated with columns  as Headings and some
columns has some formulas written.
Now after all this is done I want to call a function which will add
a column called total and display the records as shown in my earlier
post. I will have to select the columns name , range and create a
formula for TotAmount.

For Example : Present Macro has some code which looks like the
following.

oRPT = WorkSheet

ThisName = RNAMECumRRBilled
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select

Selection.FillDown

I don't understand what formula is it creating for this column and
how is it creating.

 
Answer #5    Answered By: Liam Bouchard     Answered On: Nov 01

Yes, I am getting you, but the pivot table, array formulae, D-function
and subtotal methods will all give you the totals you seem to need. Have
you tried them?

Bearing in mind you seem to be getting new data  straight from a
recordset, I'd use either subtotals or the pivot table, since either can
be set up in just a few seconds.

 
Answer #6    Answered By: Hababah Younis     Answered On: Nov 01

That is the big problem as I said am completely new to writing  a VBA
macro I was hoping for a code snippet which wich would give me some
tips on how can I do it with the existing macro. I will paste a code
snippet which is there pls advice me how to proceed. It does not
have a pivot table?

The following function (PrepareTheReport) is called from the mail
function. I need to add an extra column at the last row for evry
similar BillingDocumentNbr. There are lots of repeating
BillingDocumentNbr's with corresponding value for CumRRBilled. I
need to total up CumRRBilled for all similar BillingDocumentNbr's.

Please do me a favour and help me.

=====================================================================
' Define constants for the sheets we need to keep
Global Const PARAMSHEETNAME As String = "Parameters"
Global Const TEMPLATESHEETNAME As String = "ReportFormat"
Global Const WELCOMESHEETNAME As String = "MC Audit"

' These range names get used a lot. Having them as constants is
mostly for documentation.
Const RNAMECustomerNumber As String = "CustomerNbr"
Const RNAMEContractNumber As String = "ContractNumber"
Const RNAMESheetsToKeep As String = "SheetsToKeep"
Const RNAMEDBNames As String = "DBNames"
Const RNAMEEnvironment As String = "Environment"
Const RNAMESQLServers As String = "SQLServers"
Const RNAMETheColumns As String = "TheColumns"
Const RNAMECustomerName As String = "CustomerName"
Const RNAMECustomerNbr As String = "CustomerNbr"
Const RNAMEContractNbr As String = "ContractNbr"
Const RNAMESalesOfficeCode As String = "SalesOfficeCode"
Const RNAMESalesGroupCode As String = "SalesGroupCode"
Const RNAMEDocumentDate As String = "DocumentDate"
Const RNAMESalesOrder As String = "SalesOrder"
Const RNAMESalesOffice As String = "SalesOffice"
Const RNAMEBillingDocumentNbr As String = "BillingDocumentNbr"
Const RNAMEMCAmount As String = "MCAmount"
Const RNAMERebate As String = "Rebate"
Const RNAMESalesOrderSubTotal As String = "SalesOrderSubTotal"
Const RNAMEFinancialAdjustment As String = "FinancialAdjustment"
Const RNAMEtransaction As String = "transaction"
Const RNAMECumFinAdj As String = "CumFinAdj"
Const RNAMEMCFinAdj As String = "MCFinAdj"
Const RNAMECumMinCom As String = "CumMinCom"
Const RNAMECumEarnedRoyalty As String = "CumEarnedRoyalty"
Const RNAMEPrepaidBalance As String = "PrepaidBalance"
Const RNAMEMCInvoice As String = "MCInvoice"
Const RNAMERRInvoice As String = "RRInvoice"
Const RNAMECumMCBilled As String = "CumMCBilled"
Const RNAMECumRRBilled As String = "CumRRBilled"

Private Sub PrepareTheReport(oRPT As Worksheet)
' Organize getting the data
' put the data  in place
Dim TheDB As ADODB.Connection
Dim TheData As ADODB.Recordset

' The connection string needs some values that should be in the
Parameters...
Dim oWS As Worksheet ' just because...


Dim sDBNAME As String
Dim sDBServer As String
Dim sSQL As String
Dim MiscInt As Integer
Dim MiscRange As Range
Dim RowsIn As Long
Dim coloff As Long ' offset to column
Dim ThisName As String
Dim ThisCol As Long ' the column we're interested in
Dim oFMT As Worksheet
Dim RangeDesc As String


Set oFMT = Worksheets("ReportFormat")

Set oWS = Worksheets(PARAMSHEETNAME)
sDBNAME = oWS.Range(RNAMEDBNames).Find(oWS.Range
(RNAMEEnvironment) & "rpt").Offset(0, 1)
sDBServer = oWS.Range(RNAMESQLServers).Find(oWS.Range
(RNAMEEnvironment) & "sql").Offset(0, 1)
Set TheDB = New ADODB.Connection
sSQL = "Provider=SQLOLEDB;Data Source=SQL02;Initial
Catalog=Temp_DB; Trusted_Connection=Yes"
With TheDB
' .DefaultDatabase = sDBNAME
' .Provider = "SQLOLEDB"
.ConnectionString = sSQL
.CommandTimeout = 90
.Open
End With

Set TheData = New ADODB.Recordset

sSQL = "SELECT * FROM FNMinCommitRecon_NBR('" & oWS.Range
(RNAMEContractNumber) & "')"
With TheData
Set .ActiveConnection = TheDB
.Open (sSQL)
If .State = ADODB.adStateOpen Then
If .BOF And .EOF Then
MsgBox "No rows returned. Sorry - No report"
GoTo ExitSub
End If

' Get some values and compare them to parameters
MiscInt = .Fields.Count
If MiscInt = oWS.Range(RNAMETheColumns).Rows.Count Then
Else
Debug.Print "Mistake"
GoTo ExitSub
End If
RowsIn = 0
' Every row is supposed to have the header information,
but do the setup
' on the first row, just because it's there
ThisName = RNAMECustomerName
oRPT.Range(ThisName) = TheData.Fields(ThisName)
ThisName = RNAMECustomerNbr
oRPT.Range(ThisName) = TheData.Fields(ThisName)
ThisName = RNAMEContractNbr
oRPT.Range(ThisName) = TheData.Fields(ThisName)
ThisName = RNAMESalesOfficeCode
oRPT.Range(ThisName) = TheData.Fields(ThisName)
ThisName = RNAMESalesGroupCode
oRPT.Range(ThisName) = TheData.Fields(ThisName)

Do Until .EOF
ThisName = RNAMEDocumentDate
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMESalesOrder
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMESalesOffice
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMEBillingDocumentNbr
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMEMCAmount
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMERebate
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMESalesOrderSubTotal
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)
ThisName = RNAMEFinancialAdjustment
oRPT.Range(ThisName).Offset(RowsIn, 0) =
TheData.Fields(ThisName)

RowsIn = RowsIn + 1
.MoveNext
Loop
End If
End With

' Now fix up the Formulae

ThisName = RNAMEtransaction
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMECumFinAdj
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMEMCFinAdj
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMECumMinCom
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMECumEarnedRoyalty
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMEPrepaidBalance
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMEMCInvoice
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMERRInvoice
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMECumMCBilled
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown

ThisName = RNAMECumRRBilled
oRPT.Range(oRPT.Cells(Range(ThisName).Row, Range
(ThisName).Column), oRPT.Cells(Range(ThisName).Row + RowsIn, Range
(ThisName).Column)).Select
Selection.FillDown



' Set the print range
With oRPT.PageSetup
.PrintTitleRows = "$1:$6"
.PrintTitleColumns = ""
.PrintArea = "A6:S" & (6 + RowsIn)
.LeftFooter = "&""Arial,Bold""Microsoft Corporation
Confidential"
.CenterFooter = "&D"
.RightFooter = "Page &P of &N"
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
' .PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.FitToPagesWide = 1
.FitToPagesTall = 1000
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.25)
End With

' Put outlines around the reporting cells so it looks like
gridlines are on.
Application.Goto Reference:="Print_Area"
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
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


ExitSub:
' Clean up house before you go
If TheData.State = ADODB.adStateOpen Then
TheData.Close
End If
Set TheData = Nothing

If ADODB.adStateOpen = TheDB.State Then
TheDB.Close
End If
Set TheDB = Nothing
End Sub

 
Answer #7    Answered By: Alfonsine Miller     Answered On: Nov 01

I have directed you to the
solutions to your problems; you really don't need VBA to do this.
Particularly since - as you say - you are not experienced in VBA, an
inflexible VBA solution won't be the best way to help you.

I've given you links to investigate Dfunction and array formulae
solutions. Here is an introduction to pivot tables in Excel - THIS IS AN
EASY WAY TO ACHIEVE YOUR REQUIREMENT; most of us in here believe you
should only use VBA if you can't achieve your aims without it and this
is not such a case.

office.microsoft.com/.../HA010346321033.aspx

 
Didn't find what you were looking for? Find more on Writing Macro wanted Tips Or get search suggestion and latest updates.




Tagged: