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")
rec.MoveLast
intRows = rec.RecordCount
rec.MoveFirst
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
rec.MoveNext
Next intCount2
'Insert blank columns
Columns("I:K").EntireColumn.Insert
[K1] = "PPOSAVINGS%"
[J1] = "PPOSAVINGS"
[I1] = "PPOSTDREDUCT"
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]"
rec.Close
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
db.Close
End Sub