MrExcel Publishing
Your One Stop for Excel Tips & Solutions

VBA Question

Posted by CJ on June 01, 2001 7:51 AM

Hi, I have code that imports an access query into Excel. I need to format column G to have a comma and be a general number, columns H, I , J, L, M, N, O to be currency with no decimals, and column K to be a percentage with 2 decimal points. After that, I need to sort by column C and do subtotals on columns H, I, J, L, M, N, O for each change in column D. I can do this manually, but since this will be run so often, it will be much easier to get it in code. Any help is greatly appreciated.

Here is the code I have so far:

Private Sub cmdImport_Click()
Dim rec As Recordset
Dim rge As Range
Dim intRows As Integer
Dim intFields As Integer
Dim strSelect As String
Dim strConn As String
Dim db As Database
Dim wsp As Workspace
Dim stDocName1 As String
Dim lRow As Long
Dim RangeStr As String

'lRow = Range("A1").End(xlDown).Row

Call Clear_DataRange

Set wsp = DBEngine.Workspaces(0)
Set db = wsp.OpenDatabase("n:\PPORevenue1.mdb")
db.QueryTimeout = 15000

Set rge = Worksheets("RTF").Range("a1")

Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site")
intRows = rec.RecordCount
intFields = rec.Fields.Count

'pastes field names
For intCount1 = 0 To intFields - 1 'do as many times as there are fields
rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name
Next intCount1

'pastes field values
For intCount2 = 0 To intRows - 1 'do this as many times as there are rows
For intcount3 = 0 To intFields - 1 'do this as many times as there are fields
rge.Cells(intCount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value
Next intcount3
Next intCount2

'Insert blank columns

lRow = 1 + rec.RecordCount
RangeStr = "J" & (intCount2)

'Insert values into columns
Range("I2:I" & lRow).Formula = "=RC[-1]-RC[3]"
Range("J2:J" & lRow).Formula = "=RC[2]-RC[3]"
Range("K2:K" & lRow).Formula = "=RC[-1]/RC[-3]"

Range("A" & (lRow + 1)).Select
'Format width of columns and add border around titles
Range("A:Z").Columns.AutoFit 'starting and ending cell in ()

'With Worksheets("RTF")
'.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin
'End With

End Sub

Posted by David Rainey on June 01, 2001 8:07 AM

This is realy too much information. Can you tell me what you are having trouble with specifically.

Posted by CJ on June 01, 2001 8:08 AM

I am not sure how to do the sorting and then the subtotals and the formatting in code.

Posted by david on June 01, 2001 8:19 AM

first of all try recording a macro for the sorting and formatting.

For the subtotals it gets a little tougher if you don't know how many rows you have but it can be done.

If you want to send me a sample worksheet I will give it a shot.

just put everything where you want it to be at the end.