vb code work only in 1 wkbk: lengthy

[Zack Barresse]

i have the code to give me information from reports. i have asked specific questions before (didn't know if i should post in those, so i apologize if i needed to) about this macro. it's half coded, half recorded.

my problem is that it will only work in one report, and i don't know why. if interested, i can post the code; i won't unless someone asks cause it's so long - for a thread that is.

so please inquire if interested

edit: was going to be lengthy, but decided not to post code. sorry if misleading.

 

[Smitty]

If you're specifically referring to a named workbook in your code (like will happen when you record), that could be your problem.

Post away...

Smitty

 

[Zack Barresse]

well here is my code thus far. i know there's a lot of footnotes, but helps me. if anything is not as it should be, please let me know.

thanks.

Sub GetReport()

    'TURNING OFF UPDATING FOR USER STABILITY
    Application.ScreenUpdating = False
    
    'DELETING BLANK COLUMNS (TRIMMING)
    Columns("A:D").Select
    Range("A65502").Activate
    Selection.Delete Shift:=xlToLeft
    
    'DELETING BLANK ROWS (TRIMMING)
    Rows("1:16").Select
    Range("A16").Activate
    Selection.Delete Shift:=xlUp
    
    'FORMATTING IF/DATE COLUMN
    Columns("G:G").Select
    Selection.NumberFormat = "m/d/yyyy"
    
    'FORMATTING IF/TIME COLUMN
    Columns("H:H").Select
    Selection.NumberFormat = "[$-409]h:mm:ss AM/PM;@"
    
    'TYPING IF/DATE FORMULA
    Range("G2").Formula = "=IF(E2>20,A2,"""")"
    
    'TYPING IF/TIME FORUMLA
    Range("H2").Formula = "=IF(E2>20,B2,"""")"
    
    'SELECTING TWO PREVIOUS FORMULAS AND
    'AUTO FILLING DOWN TWO ROWS
    'NOW CHANGED TO COPY/PASTE (OLD CODE SAVED)
    Range("G2:H2").Copy Range("G3:H4")
    
    'TYPING "FLAG" FORMULA
    Range("I4").Formula = "=IF(COUNT(H2:H6)>3,""Flag"","""")"
    
    'SELECTING ALL THREE FORMULAS -> AUTOFILLING TO END OF DATA
    'NOW CHANGED TO COPY/PASTE (OLD CODE SAVED)
    Range("G4:I4").Copy Range("G5:I65520")
    
    'SELECTING FORMULA COLUMNS
    'ADJUSTING COLUMNS TO AUTOFIT AND
    'COPYING THE COLUMNS DATA
    Columns("G:I").Select
    Range("G65507").Activate
    Columns("G:I").EntireColumn.AutoFit
    Range("I65521").Formula = "=COUNTIF(I2:I65520,""Flag"")"
    Columns("G:I").Select
    Range("G65507").Activate
    Selection.Copy
    
    'PASTING INFO INTO UNUSED SHEET
    Sheets("Sheet1").Select
    Columns("A:C").Select
    'PASTING SPECIAL -> VALUES
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'PASTING SPECIAL -> FORMATS
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    'PASTING SPECIAL -> COLUMN WIDTHS (FOR PRESENTABILITY)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    'STARTING THE AUTOFILTER PROCESS (TO DELETE ALL BLANK ROWS)
    'CAN AUTO FILTER FIELD BY DATE (1), TIME (2) OR FLAG (3)
    Selection.AutoFilter
    Selection.AutoFilter Field:=3, Criteria1:="="
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Delete
    
    'COPYING RAW DATA - NO EMPTY ROWS - TO NEXT UNUSED SHEET
    Columns("A:C").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("A:C").Select
    'PASTING SPECIAL -> VALUES
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'PASTING SPECIAL -> FORMATS
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    'PASTING SPECIAL -> COLUMN WIDTHS (FOR PRESENTABILITY)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Sheet2").Select
    Application.CutCopyMode = False
    
    'HIDING PERSONAL.XLS BOOK
    Windows("PERSONAL.XLS").Activate
    ActiveWindow.Visible = False
    
    'SETTING NAME FOR FILE
    Dim newFile As String
    newFile = InputBox(Prompt:="What would you like your file name to be?")
        If newFile = Empty Then
        MsgBox Prompt:="You must enter a valid file name."
        Else
        MsgBox Prompt:="Your new report file will be named " & newFile & ".xls"
        End If
    
    'COPYING NEWLY ACQUIRED (& FORMATTED) DATA TO A NEW FILE
    'IN THE SAME FOLDER
    Sheets("Sheet2").Copy
     ChDir _
        "C:\Documents and Settings\Rob\My Documents\EXCEL files off Dell 4100 2Dec01\Data\Kinzua\AIR\reports"
    ActiveWorkbook.SaveAs Filename:= _
        newFile _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    'CLOSING THE ORIGINAL REPORT - DO NOT SAVE ORIGINAL
    '
    'THIS WILL EVENTUALLY NEED TO BE ADJUSTED UNLESS ALL
    'FILE NAMES ARE GOING TO BE THE SAME.  DON'T KNOW THE
    'CODE RIGHT NOW, SO EVERYTHING WILL BE THE SAME, OR THIS
    'WILL BE ADJUSTED EVERY TIME :(
    Windows("Day_Report opacity 2003").Activate
    ActiveWindow.Close False
    
End Sub

 

[Smitty]

Hey Zack,

So what exactly isn't working?

Your code can use some trimming, but it will help to know where/why it's bombing.

I see a few places where an error could occur, but need you to point out the specifics.

Have a great weekend & I hope it's a bit nicer up there this weekend!

Smitty

 

[Zack Barresse]

- as for the weather.

as for my code, well, i don't get any type of error at all. it runs fine in the one specific file. but anytime i run it in any other file it freezes up and ends up closing out, then wants to send an error report to MS.

i don't know why this is. if you've got any ideas, i think i'm about as far as i can go for now.

i'm leaving it alone until monday cause i wanna my keyboard.

hey, thank you for taking the time to look this one over Smitty. I appreciate the help, lord knows i need it.