Transfer specific data from several sheets to one summary sheet

[icklemiller]

Hi, this is my first post- looking for a bit of help. I'm ok with certain formulas/functions, but a total macro virgin.

What i'm essentially trying to do is...

I have a production workbook, with two summary pages that feed from various bits of information on all my other sheets (one for each day in the month).

I'm trying to create a third summary sheet that will show me a list of what stage our various jobs are at in the production cycle- e.g. if the job (entered in one row, over various colums) has a "S" in the first column, it's at "setting out" stage and should automatically appear under the "setting out" jobs heading on the new summary sheet. When the "S" is changed to a "M" it should then jump out from under this heading and into the next heading, etc, etc, 'till the job is complete.

There will be 6 different stages (s,m,j,b,p,d) and each stage should have an area of it's own in the new sheet, where all of the relevant jobs fall under- the information will be pulled from potentially 31 different other sheets (one for each day of the week)

Hope this description makes sense- any ideas?

 

[sweater_vests_rock]

hi icklemiller

welcome to the board!

try the code below. note that you'll need to modify two lines to reflect your worksheet setup (I've assumed you have the stage column and the job name column in the same place on each daily sheet).

stStage = "A:A" 'Job Stage Column; in this example, Column A
inJob = 1 'Job Name column # - Job Stage column #; in this example, Job names are in Column B

actually, i've assumed a lot here because i wasn't sure about the specifics of your worksheets...hopefully it works anyways

cheers. ben.

Sub JobSummary()

    Dim wsSum As Worksheet
    Dim rg_S As Range, rg_M As Range, rg_J As Range, rg_B As Range, rg_P As Range, rg_D As Range
    Dim inJob As Integer
    Dim c As Range
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
'   ENSURE SUMMARY SHEET EXISTS
    On Error Resume Next
    With ThisWorkbook
        Set wsSum = .Worksheets("Summary")
        If wsSum Is Nothing Then
            Set wsSum = .Worksheets.Add
            wsSum.Name = "Summary"
        End If
    End With
    
    On Error GoTo EH:
    
    With wsSum
'       PREP SUMMARY SHEET
        .UsedRange.ClearContents
        .Range("A1").Value = "S Stage"
        .Range("B1").Value = "M Stage"
        .Range("C1").Value = "J Stage"
        .Range("D1").Value = "B Stage"
        .Range("E1").Value = "P Stage"
        .Range("F1").Value = "D Stage"

'       SET JOB STAGE RANGES
        Set rg_S = .Range("A2")
        Set rg_M = .Range("B2")
        Set rg_J = .Range("C2")
        Set rg_B = .Range("D2")
        Set rg_P = .Range("E2")
        Set rg_D = .Range("F2")
    End With
    
    stStage = "A:A" 'Job Stage Column; in this example, Column A
    inJob = 1 'Job Name column # - Job Stage column #; in this example, Job names are in Column B
    
'   Loop through workbook, copying job names from each sheet to the correct column stage on the summary sheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsSum.Name Then

'           Loops through each cell in the job stage column
            For Each c In Intersect(ws.UsedRange, ws.Range(stStage))
                If InStr(1, "smjpbpd", c.Value, vbTextCompare) > 0 Then c.Offset(0, inJob).Copy
            
'               Copies job name to the correct column stage
                Select Case c.Value
                    Case "s"
                        rg_S.PasteSpecial
                        Set rg_S = rg_S.Offset(1, 0)
                    Case "m"
                        rg_M.PasteSpecial
                        Set rg_M = rg_M.Offset(1, 0)
                    Case "j"
                        rg_J.PasteSpecial
                        Set rg_J = rg_J.Offset(1, 0)
                    Case "b"
                        rg_B.PasteSpecial
                        Set rg_B = rg_B.Offset(1, 0)
                    Case "p"
                        rg_P.PasteSpecial
                        Set rg_P = rg_P.Offset(1, 0)
                    Case "d"
                        rg_D.PasteSpecial
                        Set rg_D = rg_D.Offset(1, 0)
                End Select
            Next c
        End If
    Next ws


EH:
    Application.ScreenUpdating = True
    
    With Err
        If .Number <> 0 Then MsgBox "Oops! There is an error! Conduct error checking!"
        .Clear
    End With
        
    Set c = Nothing
    Set ws = Nothing
    Set wsSum = Nothing
    Set rg_S = Nothing
    Set rg_M = Nothing
    Set rg_J = Nothing
    Set rg_B = Nothing
    Set rg_P = Nothing
    Set rg_D = Nothing
      
End Sub

 

[icklemiller]

Hi Ben,

Thank you so much for your reply... i really appreciate the code, however the next problem lies in the fact that, when you say "try this code" i have absolutely no idea where to start... we're talking macro's for DUMMIES here... the only experience i have in macro code is copying and pasting from one page to the next once a month for about 6/7 months!!!

In any case, your presumptions were correct... each and every page (for each day of the month) with have the same column reference for each heading, eg, status, customer, product description, department, etc, etc

if it helps i could upload a copy of the workbook (if i knew how to do so!!!)

 

[sweater_vests_rock]

no worries. see the link in my signature -- that should help explain where to put this code, how to run it, etc

where do i put this code? - http://www.mcgimpsey.com/excel/modules.html

when you copy the code into your book, you'll need to edit the two lines I pointed out based on your worksheet setup. write back if you have trouble (and there is no where to upload your workbook, due to the risk of viruses...)

hth. ben.

 

[icklemiller]

Ok Ben,

I've copied the code in ur second box into a module in the VBE and hit close and return to XL, now... dont know what to do from here... have inserted a new sheet which is where i want the summary to go, but dont know how to start feeding the info over...

I'm sorry for being such a total dumb-*** on this subject...

 

[sweater_vests_rock]

no worries!

on the menu bar, go to

Tools => Macro => Macros (with a play button)
[alternatively, use the shortcut ALT+F8]

this will pull open a userform called "Macro". select the macro you want (in this case "JobSummary" and then click the "Run" button. the macro will run pretty quickly, so you may not notice anything different until you go to the tab named "Summary"

let me know if you have problems. ben.

 

[icklemiller]

Thanks for this Ben- will give it a bash on Monday morning- 5pm here- means i'm out the door to start my weeked!! Hope you have a good one and thanks again for all your help!!

 

[icklemiller]

Ok...tried that this morning and after i clicked 'run' got an error messge reading "syntax error". I presume this is to do with the text content, but because i dont really know what i'm doing here, I dont know what im looking for in terms of a mistake or something...

 

[sweater_vests_rock]

that's weird. where is the syntax error occuring? are you working in xl07 or xl03?

 

[icklemiller]

Emmm...xl02!!! Old skool!! Got it sorted now tho...had to remove the underscores at the end!

Thanks again for your help!