Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

Thread: HELP ME pretty Please

  1. #1
    Guest

    Default

    I need help making column E multiply values by 100. So I can get rid of the decimals. The bank wants decimals to be assumed. Values in E are currency when I import them. This is a macro that does everything for me. I push a button and it does it all except move the decimals. I can not figure out how to tell VB to multiply by 100 for the current imported text. Please Help

    Sub GetFile()
    Dim date1
    Dim Text
    Dim Fname As Variant
    Dim FileName As String
    Range("D8").Select
    ActiveCell.Value = ""
    Sheets("Menu").Select
    PathName = Range("D3").Value
    FileName = Range("D4").Value
    TabName = Range("D5").Value
    Filename1 = PathName & FileName
    'Fname = Application.GetOpenFilename _
    (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
    ControlFile = ActiveWorkbook.Name
    'Workbooks.OpenText FileName:=Pathname & FileName
    Workbooks.OpenText FileName:=Filename1, _
    DataType:=xlDelimited, Comma:=True

    'Workbooks.Open (Filename:=PathName & Filename,delimiter:=2)
    ActiveSheet.Name = TabName
    Sheets(TabName).Copy After:=Workbooks(ControlFile).Sheets(1)


    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("a1").Select

    Worksheets("Import").Columns("A"). _
    NumberFormat = ("000000000000")
    Worksheets("Import").Columns("d"). _
    NumberFormat = ("0000000000")
    Worksheets("Import").Columns("e"). _
    NumberFormat = ("000000000000")
    Worksheets("Import").Columns("f").NumberFormat = "yyyymmdd"


    Dim Labeldate
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim Range1 As Range
    ActiveSheet.Name = TabName
    ActiveSheet.UsedRange.Select
    ' Prompt user for destination file name.
    DestFile = InputBox("Enter the destination filename" _
    & Chr(10) & "(with complete path):", "Quote-Comma Exporter")








    ' Obtain next free file handle number.
    FileNum = FreeFile()

    ' Turn error checking off.
    On Error Resume Next

    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum

    ' If an error occurs report it and end.
    If Err <> 0 Then
    MsgBox "Cannot open filename " & DestFile
    End
    End If

    ' Turn error checking on.
    On Error GoTo 0

    ' Loop for each row in selection.
    For RowCount = 1 To Selection.Rows.Count

    ' Loop for each column in selection.
    For ColumnCount = 1 To Selection.Columns.Count

    ' Write current cell's text to file with quotation marks.

    Print #FileNum, """" & Selection.Cells(RowCount, _
    ColumnCount).Text & """";

    ' Check if cell is in last column.
    If ColumnCount = Selection.Columns.Count Then
    ' If so, then write a blank line.
    Print #FileNum,
    Else
    ' Otherwise, write a comma.
    Print #FileNum, ",";
    End If
    ' Start next iteration of ColumnCount loop.
    Next ColumnCount
    ' Start next iteration of RowCount loop.
    Next RowCount

    ' Close destination file.
    Close #FileNum
    Windows(FileName).Activate
    ActiveWorkbook.Close SaveChanges:=False
    Windows(ControlFile).Activate
    ActiveSheet.Name = "Complete"
    Sheets("Menu").Select
    Range("D8").Select
    ActiveCell.Value = "Complete"
    Range("D9").Select

    End Sub


  2. #2
    Guest

    Default

    You could run a macro after your existing procedure like:

    Sub changeVals()
    Application.ScreenUpdating = False
    myrng = ActiveCell.Address
    Columns("e").Select
    For Each cell In Selection
    If ActiveCell <> "" Then
    ActiveCell = ActiveCell * 100
    End If
    On Error GoTo errorhandler
    ActiveCell.Offset(1, 0).Select
    Next
    errorhandler:
    Range(myrng).Select
    Application.ScreenUpdating = True
    End Sub


    Hope this helps. Cheers,

    Nate

  3. #3
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Whoops, didn't mean to sign anon....

    Cheers, Nate

  4. #4
    Guest

    Default

    Nate,
    You are the man
    Thanks a lot that worked exactly the way I wanted.
    Brandon

  5. #5
    Guest

    Default

    Thanks Brandon! While we're talking about it, if you have text in column E for one reason or another, the macro above will not multiply numbers in rows below the text entry. But the one below will:

    Sub changeVals2()
    Application.ScreenUpdating = False
    myrng = ActiveCell.Address
    Columns("e").Select
    For Each cell In Selection
    If ActiveCell <> "" And _
    WorksheetFunction.IsNumber(ActiveCell) = True Then
    ActiveCell = ActiveCell * 100
    End If
    On Error GoTo errorhandler
    ActiveCell.Offset(1, 0).Select
    Next
    errorhandler:
    Range(myrng).Select
    Application.ScreenUpdating = True
    End Sub

    Cheers,

    Nate

  6. #6
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Did it again! Golly gee whiz!

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •