• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Consolidating spreadsheets

G

Gamma48

Member
Hello all,

I am hoping the brilliant minds here may have some suggestions on how to speed up or even rework a data format/transfer from one worksheet to another, all being contained in the same workbook. I am taking 2-column project punch lists from multiple users, each on its own worksheet and consolidating them into a formatted master copy. The length of each list varies depending upon the day. All the sheets are formatted the same. User Name is column A. Task is column B.

Right now, I have a hidden sheet that has formulas keeping the unformatted running list from all the sheets' data. From this formula driven list, I have a macro move this info with a command button to another range of cells (.value = .value) and format with blank rows between each user's punch list (running from the bottom up) and then move again (.value = .value) to the master. I can't move directly to the master sheet and then insert the blanks, but rather have to move the already formatted data because of data tracking formulas already in place on the master.

Basic flow:
User generated data on multiple sheets
>Hidden sheet consolidates punch lists
>>Macro transfers all data to empty cells, .value = .value
>>>Macro then inserts necessary blank lines from bottom of listing up
>>>>Macro then transfers formatted data to master sheet, .value = .value

Does it work? Yes. Really only take a 5-8 seconds on the longer punch lists
Is it pretty? No.
Are there some quirks to how the data has to be entered to run properly? Yup.(Can't have duplicate headings, otherwise the initial Index/match on the hidden sheet doesn't work correctly)

I am one of those people who will tweak something until it breaks just to learn how to fix it.

A couple aspects I'm looking at reworking:

-I think it might be best to do the initial consolidation with a macro running instead of a formula so that each heading doesn't have to be unique. Sometimes a simple heading ("Painting" or "Drywall") is all that is needed and very easily duplicated on multiple jobs, but would still need to be listed separately for multiple jobs. I've been using qualifiers to identify different users to facilitate the Index/Match and prevent this (User :: Task/Job).

-I just wasn't sure how to manipulate the data without having to transfer the info twice.

In essence, I would be looking at a macro that would run through sheet1 removing all excess blank lines except for one blank between User Names moving the data to the master, and then move on to sheet2, sheet3, etc.

Looking forward to some enlightenment. Thanks.

EDIT: attached sheet that hopefully helps
 

Attachments

  • Consolidate WS.xlsm
    27.9 KB · Views: 5
Last edited:
Thanks for the link Luke. I'm going to read through them now. May post back here in a couple days if I have any questions after working with it some.
 
Forgive me Luke, but I am having a problem conceptualizing another way to manipulate the data flow. I read through the link, a number of times actually. I feel that the answer is "right there" but I'm still missing it.

Currently:
Read data>>transfer(not copy, but .value = .value)>>manipulate by inserting blank row between sections (so master formatting isn't altered because of formulas)>>transfer to master

Is there a way to:
Read data to memory?>>manipulate>>transfer to master

Back to the drawing board with Ron's code...
Thanks.
 
VB does have the capability of being able to read something into a stored variable, and then perform changes. The other possiblity is to do the transfer as is, but then manipulate the data in the cells. What type of manipulation are you needing?
 
I am trying to take 12 spreadsheets and pull data from two columns into one master ("A" & "D"). A few of the spreadsheets have 15 sections, with 20 lines per section. Other sheets only have 3-4 sections. So the templates aren't identical. All of the sections combined form the punch list for each job site. Sometimes a section will use all 20 lines. Sometimes the user needs only one or two lines with the remainders left blank before getting to the next section.

I'm trying to create a master punch list that would pull each category from each spreadsheet and leave one blank line between. (I have an autofilter that is used to "shrink" and hide the extra blank lines when printing hard copies.)
 
Does the Add-in not work properly?
http://www.rondebruin.nl/win/addins/rdbmerge.htm

Looks like it has the option to only copy "to last cell". This sounds like what you want...

The other idea is to have the macro AutoFilter the data at the end and delete blank rows.

If I'm still off the mark, could you provide and example of what a master summary punch looks like?
 
So the answer may have been in front of me this whole time... Is it possible to copy data as it is presented after an autofilter has been run? If so, since the autofilter cleans up the layout, it could then create the master from the individual ranges with the autofilter turned on. I'll go digging around to see about this...

Also, there is a worksheet in the very first post that should help show an abridged layout. If it doesn't help, then I can add more detail to it.
 
This gets one sheet...and yes I know it's ugly to look at....
Code: 
Sub filtertransfer()
    Dim rng As Range
    Dim ws As Worksheet
  
    Application.ScreenUpdating = False
  
    Set ws = ActiveWorkbook.Worksheets("Initial")
    Set rng = ActiveWorkbook.Worksheets("Master").Range("A1:B320")
  
    rng.Select
    Selection.ClearContents
    
    With ws
        .Range("$AH$13:$AJ$320").AutoFilter Field:=3, Criteria1:="="
        .Range("A13:A320").SpecialCells(xlCellTypeVisible).Copy _
            Sheets("sheet1").Range("A1")
        .Range("D13:D320").SpecialCells(xlCellTypeVisible).Copy _
            Sheets("sheet1").Range("B1")
    End With
  
    Range("A1").Select
  
    Application.ScreenUpdating = True
  
End Sub

How would looping through multiple sheets work if the formatting is different?
For instance, sheet "Initial" would have a pertinent range of "A10:320" and "D10:320",
while sheets "UN* (numbered 1-10)" would have a range of "A10:55" and "D10:55".
 
Here's an example of finding the last row in a sheet, and using that info to define a range.
Code: 
Sub ExampleLoop()
Dim ws As Worksheet
Dim endRow As Long
Dim myRange As Range


For Each ws In ActiveWorkbook.Worksheets
    With ws
        endRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set myRange = .Range("A10:A" & endRow & ",D10:D" & endRow)
       
        'What do we do with this range?
        MsgBox myRange.Address
    End With
Next ws
End Sub
 
I'm pulling the data from the middle of the sheets. There are rows above, which are basic office keeping info, and the rows below, which are individual user's notes, that do not need to be factored into the macro which is why I thought I would have to specifically state the ranges with A10:A320 and D10:D320 on sheet "Initial" and A10:A55 and D10:D55 on another set of sheets with names starting with "UN" and a #..."UN1", "UN2".....
 
Ah, I see. In that case, perhaps like this?
Code: 
Sub ExampleLoop()
Dim ws As Worksheet
Dim endRow As Long
Dim myRange As Range


For Each ws In ActiveWorkbook.Worksheets
    Select Case UCase(Left(ws.Name, 2))
   
    'Determine which sheet we are looking at
    Case "IN"
        endRow = 320
    Case "TA"
        endRow = 55
    Case Else
        'Ignore
    End Select
    With ws
        Set myRange = .Range("A10:A" & endRow & ",D10:D" & endRow)
       
        'What do we do with this range?
       MsgBox myRange.Address
    End With
Next ws
End Sub
 
Reporting back...I am going back and forth between your code and Ron's code in the link you gave me above. This is bonking on the bold line below:

filterRange.AutoFilter Field:=1, Criteria1:="<>x"

Error 1004: The command could not be completed by using the range specified. Select a single cell within the range and try the command again.

I am able to run through the first worksheet. But it falls apart on the second worksheet.
Code: 
Sub AutoFilterTransfer()
    Dim myRange As Range
    Dim filterRange As Range
    Dim ws As Worksheet
    Dim destWs As Worksheet
    Dim startRow As Long
    Dim endRow As Long
    Dim Last As Long
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set destWs = ActiveWorkbook.Worksheets("sheet1")
    destWs.Range("A3:B320").Select
    Selection.ClearContents
     
    For Each ws In ActiveWorkbook.Worksheets
        Select Case UCase(Left(ws.Name, 2))
        Case "PR"
            startRow = 13
            endRow = 320
         Case "CO"
            startRow = 10
            endRow = 56
         Case Else
            'Ignore
        End Select
     
        Last = LastRow(destWs)
     
         With ws
            .AutoFilterMode = False
            Set myRange = .Range("A" & startRow & ":A" & endRow & ",D" & _
                startRow & ":D" & endRow)
            Set filterRange = .Range("AJ" & startRow & ":AJ" & endRow)
            filterRange.AutoFilter Field:=1, Criteria1:="<>x" 'Falls apart here
         End With
         
         myRange.Copy
       
         With destWs.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
          End With
       
    Next ws
 
    Application.Goto destWs.Cells(3)
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

__________________________________________
'In its own module
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A3"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Since Sheet1 is in the ActiveBook, need to make sure we aren't trying to copy from Sheet1. The following appears to run on my machine.
Code: 
Sub AutoFilterTransfer()
    Dim myRange As Range
    Dim filterRange As Range
    Dim ws As Worksheet
    Dim destWs As Worksheet
    Dim startRow As Long
    Dim endRow As Long
    Dim Last As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set destWs = ActiveWorkbook.Worksheets("sheet1")
    destWs.Range("A3:B320").Select
    Selection.ClearContents
     
    For Each ws In ActiveWorkbook.Worksheets
        If UCase(ws.Name) = "SHEET1" Then GoTo NextSheet
        Select Case UCase(Left(ws.Name, 2))
        Case "PR"
            startRow = 13
            endRow = 320
         Case "CO"
            startRow = 10
            endRow = 56
         Case Else
            'Ignore
       End Select
     
        Last = lastRow(destWs)
     
         With ws
            .AutoFilterMode = False
            Set myRange = .Range("A" & startRow & ":A" & endRow & ",D" & _
                startRow & ":D" & endRow)
            Set filterRange = .Range("AJ" & startRow & ":AJ" & endRow)
            filterRange.AutoFilter Field:=1, Criteria1:="<>x" 'Falls apart here
        End With
         
         'Added special cells call-out, since we don't want to copy the rows
         'that we just filtered. :)
         myRange.SpecialCells(xlCellTypeVisible).Copy
       
         With destWs.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
          End With
NextSheet:
    Next ws

    Application.Goto destWs.Cells(3)
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
I made your changes, but still seem to get the 1004, "the command could not be completed by using the range specified. Select a single cell within the range and try the command again".
Code: 
filterRange.AutoFilter Field:=1, Criteria1:="<>x"

As I step through the error, it shows the variables for this still set for the "PR" sheet even though it has already been copied instead of cycling on to the "CO" sheets.
Code: 
   With ws
     .AutoFilterMode = False
     Set myRange = .Range("A" & startRow & ":A" & endRow & ",D" & _
     startRow & ":D" & endRow)
     Set filterRange = .Range("AJ" & startRow & ":AJ" & endRow)
     filterRange.AutoFilter Field:=1, Criteria1:="<>x"
End With
 
Do you have sheets in your workbook that don't match the PR or CO naming convention? If so, we can modify our Case Else line.
Code: 
        Select Case UCase(Left(ws.Name, 2))
        Case "PR"
            startRow = 13
            endRow = 320
         Case "CO"
            startRow = 10
            endRow = 56
         Case Else
            GoTo NextSheet
      End Select
 
So it's working pretty well. Just making some minor tweaks here and there, but I'm trying to get the code to skip a sheet if a referenced cell is equal to a certain value. I've been working with IF/THEN/ELSE and Instr but can't seem to get either option to work. I've flip flopped the IF/THEN inside and outside of the WITH statement. I've also tried setting a variable, 'Check', to compare against. No luck.

Code: 
'If cell ("A" & startRow) equals "[DESC]",
'then kick out to next sheet, otherwise run
'autofilter. Right now, it runs on every sheet,
'even those with "[DESC]" in the cell
 With ws  
      If Range("A" & startRow).Value = "[DESC]" Then
         GoTo NextSheet                                   
      Else
         .AutoFilterMode = False
         Set myRange = .Range("A" & startRow & ":A" & endRow & ",D" & _
             startRow & ":D" & endRow)
         Set filterRange = .Range("AJ" & startRow & ":AJ" & endRow)
             filterRange.AutoFilter Field:=1, Criteria1:="<>x"
     End If
 End With
 
Very close. Need to put a period in front of the Range so that VB knows to trace back to the With statement, rather than the ActiveSheet (which is the default).
Code: 
 If .Range("A" & startRow).Value = "[DESC]" Then
 
Nevermind. That fixed it. I had fat fingered the text to check against. Kinda hard to validate against a mispelled value. Thanks Luke, you're a freakin rock star!
 
You must log in or register to reply here.
Back
Top