|
dementedmuppet
|
 |
« Reply #10 on: February 14, 2008, 03:02:00 PM » |
|
Tinjaw's code works well. I was supposed to have the reports done two days ago. My macros were buggy. Scoured VB help & killed a few trees printing some VB help (hopefully, this addiction to paper will pass). Yesterday, Excel was getting hung up on converting cells. Driving home, I realized the problem was likely that I left "#VALUE!" errors in the range I told Excel to convert to numbers. Brilliant  After six hours of trying to fix the macros, I clicked the little "!" help icon that was beside the data that needed modified. One option was "help with this error." The solution was "multiply by 1". That WOULD explain why there are no VB methods to fix the issue. See? Hopeless  Sub PDE_RSPNS2()
'
' PDE_RSPNS2 Macro
' Macro recorded 2/11/2008 by muppet
'
' Keyboard Shortcut: Ctrl+Shift+I
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;W:\Output\30923\Encounter_Data\Archive\PDE Convert to Excel\target.txt", _
Destination:=Range("A7"))
.Name = "target"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 5, 2, 5, 5, 2, 9, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 9, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 9, 1)
.TextFileFixedColumnWidths = Array(3, 7, 40, 20, 20, 8, 1, 8, 8, 9, 2, 19, 2, 15, 2, 1, 1, 1 _
, 10, 3, 2, 15, 1, 1, 1, 1, 1, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 109, 3, 2, 15, 5, 5, 20, 2, 3, 3, 3, 3, 3, 3, _
3, 3, 3, 3, 15)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.ScrollRow = 1
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Sub convertToCurrency()
'
' convertToCurrency Macro
' Macro recorded 2/13/2008 by muppet
'
' Keyboard Shortcut: Ctrl+Shift+C
'
'Add currency conversion formula to cells in temporary columns
Range("BE9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BF9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BG9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BH9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BI9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BJ9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BK9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BL9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BM9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BN9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BO9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BP9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
Range("BQ9").Select
ActiveCell.FormulaR1C1 = "=format_currency2(RC[-30])"
'Copy formulas down columns to format all temporary currency cells
Range("BE9").Select
Selection.Copy
Range("BE10").Select
Range("BE10:BE18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BF9").Select
Selection.Copy
Range("BF10").Select
Range("BF10:BF18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BG9").Select
Selection.Copy
Range("BG10").Select
Range("BG10:BG18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BH9").Select
Selection.Copy
Range("BH10").Select
Range("BH10:BH18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BI9").Select
Selection.Copy
Range("BI10").Select
Range("BI10:BI18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BJ9").Select
Selection.Copy
Range("BJ10").Select
Range("BJ10:BJ18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BK9").Select
Selection.Copy
Range("BK10").Select
Range("BK10:BK18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BL9").Select
Selection.Copy
Range("BL10").Select
Range("BL10:BL18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BM9").Select
Selection.Copy
Range("BM10").Select
Range("BM10:BM18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BN9").Select
Selection.Copy
Range("BN10").Select
Range("BN10:BN18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BO9").Select
Selection.Copy
Range("BO10").Select
Range("BO10:BO18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BP9").Select
Selection.Copy
Range("BP10").Select
Range("BP10:BP18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("BQ9").Select
Selection.Copy
Range("BQ10").Select
Range("BQ10:BQ18280").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Copy format_currency VALUES to new columns, convert to NUMBER, format as CURRENCY
Range("BE9").Select
Range("BE9:BQ18280").Select
Selection.Copy
Range("BR9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("BR9").Select
Range("BR9:CD18280").Select
Application.WindowState = xlNormal
Application.WindowState = xlNormal
Application.WindowState = xlNormal
Application.WindowState = xlMaximized
Application.WindowState = xlNormal
ActiveWindow.LargeScroll Down:=8
Selection.NumberFormat = "$#,##0.00_);($#,##0.00)"
'Hide columns that contained non-currency data partially processed data
Columns("AA:AM").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=15
Columns("BE:BQ").Select
Selection.EntireColumn.Hidden = True
End Sub
'This code block was provided by Chaim Krause
Function format_currency2(ByVal money As String) As String
'convert from internal format to currency
Select Case Right(money, 1)
'positive numbers
Case "{"
money = Left(money, Len(money) - 1) & "0"
Case "A"
money = Left(money, Len(money) - 1) & "1"
Case "B"
money = Left(money, Len(money) - 1) & "2"
Case "C"
money = Left(money, Len(money) - 1) & "3"
Case "D"
money = Left(money, Len(money) - 1) & "4"
Case "E"
money = Left(money, Len(money) - 1) & "5"
Case "F"
money = Left(money, Len(money) - 1) & "6"
Case "G"
money = Left(money, Len(money) - 1) & "7"
Case "H"
money = Left(money, Len(money) - 1) & "8"
Case "I"
money = Left(money, Len(money) - 1) & "9"
'negative numbers
Case "}"
money = "-" + Left(money, Len(money) - 1) & "0"
Case "J"
money = "-" + Left(money, Len(money) - 1) & "1"
Case "K"
money = "-" + Left(money, Len(money) - 1) & "2"
Case "L"
money = "-" + Left(money, Len(money) - 1) & "3"
Case "M"
money = "-" + Left(money, Len(money) - 1) & "4"
Case "N"
money = "-" + Left(money, Len(money) - 1) & "5"
Case "O"
money = "-" + Left(money, Len(money) - 1) & "6"
Case "P"
money = "-" + Left(money, Len(money) - 1) & "7"
Case "Q"
money = "-" + Left(money, Len(money) - 1) & "8"
Case "R"
money = "-" + Left(money, Len(money) - 1) & "9"
End Select
format_currency2 = money * 0.01
End Function The macro comments included my name (now removed). Why don't I add my social security number, passwords, etc... Genius, I tell ya. GENIUS! |
Logged
