+ Reply to Thread
Results 1 to 1 of 1

Vba Excellence Needed..... Please??

  1. #1
    Registered User
    Join Date
    07-06-2006
    Posts
    29

    Talking Vba Excellence Needed..... Please??

    Hey Guys, Could really do with a hand. Needing a VBA whizz.

    See if you can get your head round this?

    Problem is:

    In folder DHSC S&A, there is:

    73 files, which are used by managers all with sheets 1-52 and masterentry, summary, monthly breakdown. The 1-52 represents 52 weeks of the year. I currently have code to copy the masterentry sheet to the relevant sheet when selected. There is also a summary file (This is were i am having problems with the code)

    So all in all there are 74 files.

    The code I have should open all sheets on the selected week (msg box), then look at the week number and copy the rows which have numeric digits in columns 6-12. starting from row 12.

    When i run the macro within the summary file, it lists the names of the 73 files and trys opening the summary file which is already open. The code should be bringing back the rows which have numeric data in columns 6-12. starting at row 12.

    I think the code is nearly there, but I think there may be something wrong with this bit?

    Here is the code I got already.

    Sub ListInfobyFile()

    'Determine what tab to look in, A1 should have 1-52
    ChWeek = InputBox("What Week")

    If 1 > ChWeek Or ChWeek > 52 Then
    Exit Sub
    Else
    End If

    Range("A1").Select 'Start of the new list. Change as required

    'Look in this file path to get a list of files in the folder, change this as required
    Folderpath = ThisWorkbook.Path
    Filenm = Dir(Folderpath & "\*.xls", vbNormal + vbReadOnly)

    i = 1
    Do While Filenm <> ""
    i = i + 1
    Filenm = Dir
    If Filenm = "" Then Exit Do

    'Paste the name
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Filenm

    'goto next row
    ActiveCell.Offset(1, 0).Select

    'open File
    Workbooks.Open Filename:=Folderpath & "\" & Filenm
    ActiveWB = ActiveWorkbook.Name

    'Goto Week Tab
    For Each ws In Worksheets
    If ws.Name = ChWeek Then
    Sheets(ChWeek).Select


    'Check Range
    'Determine number of rows to check
    countrows = Range("B12:B" & Range("B10000").End(xlUp).Row).Count

    'Check for values in F:L
    For r = 12 To 12 + countrows
    For c = 6 To 12 'Cols F:L
    If Application.IsNumber(Cells(r, c)) Then 'Copy row to Summary

    Rows(r).Copy
    ThisWorkbook.Activate
    Sheets("Summary").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Select
    Application.CutCopyMode = False
    Windows(ActiveWB).Activate
    Exit For
    End If
    Next c
    Next r
    GoTo NextFilenm
    End If
    Next ws

    NextFilenm:
    ActiveWorkbook.Close
    ThisWorkbook.Activate

    Loop

    End Sub

    A PICTURE OF THE TEMPLATE IS ATTACHED, THIS TEMPLATE IS STANDARD ALL OF THE 73 SHEETS WHICH MANAGERS USE.
    I am not the best within VBA, so please forgive me. Would really appreciate your help.

    Cheers

    Andrew
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1