Page 1 of 2 12 LastLast
Results 1 to 15 of 24

Thread: Data merge code

  1. #1
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi,

    I have a workbook with 11 sheets. For this purpose, I'll call them sheetX (destination) and sheets 1-10 (source).

    I want to create an array of sheets 1-10 and for each sheet in the array, copy B2:F endXLup to sheetX, starring at B4.

    Then, in sheetX, I need to loop through all of column B and delete the row if column B is blank or contains "sum:"

    How is the best way to do this?

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Could you attach a sample workbook with several example source sheets and what the destination sheet for that example should look like?

    Steve

  3. #3
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='sdckapr' post='786845' date='30-Jul-2009 17:15']Could you attach a sample workbook with several example source sheets and what the destination sheet for that example should look like?

    Steve[/quote]

    That may be a little difficult, I'll try and get something together soon....

  4. #4
    3 Star Lounger
    Join Date
    Nov 2005
    Location
    Asia Pacific, Bangkok Metropolis
    Posts
    378
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='VegasNath' post='786842' date='30-Jul-2009 23:57']Hi,

    I have a workbook with 11 sheets. For this purpose, I'll call them sheetX (destination) and sheets 1-10 (source).

    I want to create an array of sheets 1-10 and for each sheet in the array, copy B2:F endXLup to sheetX, starring at B4.

    Then, in sheetX, I need to loop through all of column B and delete the row if column B is blank or contains "sum:"

    How is the best way to do this?[/quote]

    Try perhap Consolidate to merge the data and Go To >> Special would work
    Hope this is helpful

    francis, <img src=/S/cheers.gif border=0 alt=cheers width=30 height=16>

    My Reading

    Pivot Table 101
    Pivot Table
    Array

  5. #5
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='sdckapr' post='786845' date='30-Jul-2009 17:15']Could you attach a sample workbook with several example source sheets and what the destination sheet for that example should look like?

    Steve[/quote]

    Here you go. This is a mock up of the file. I have created the blank destination sheet, the 10 source sheets and a seperate sheet that shows the expected result. The data is far from ideal. Hope this is OK.

    [attachment=84928ummy_Data.xls]

    Thanks for your help.
    Attached Files Attached Files

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    I don't see anything at all on sheet "02" that would lead to placing the text "Channel Sainsbury (Derv)" on sheet "x" behind the number 2, as in your "Expected Result" sheet...

  7. #7
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Eyes like a hawk!

    You are absolutely correct. My error in setting up the dummy file. Rows 110 & 123 will not be in the expected output, because in sheet 02, there is no header in column B, and blanks in B should be deleted.

    The actual data is far from ideal, as the data is not completely uniformed. So in this case, the header row will have to be deleted. I have suggested more uniformed output.

  8. #8
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    My apologies, but I have noticed that I cannot delete the entire rows for blanks and "sum", as there is other data to the right of the output x sheet. I would need to delete only B:F, moving cells upwards.

  9. #9
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Next problem: you state that you want to copy "copy B2:F endXLup". But for most of your source sheets, column F is blank so there would be nothing to copy.

    Nathan, you will have to be much more precise!

  10. #10
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    More apologies

    Sheet 1 has a column F, but sheets 2:10 do not, so I would like to use B:F for all. The copy should always start at row 2 and end with the last row that has data in column B.

  11. #11
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Does this do what you want?

    Code:
    Sub FillX()
      Dim wshX As Worksheet
      Dim wsh As Worksheet
      Dim i As Integer
      Dim r As Long
      Dim m As Long
      ' Set reference to target sheet
      Set wshX = Worksheets("x")
      ' Optional - clear target sheet
      wshX.Cells.Delete
      ' Starting row
      r = 4
      ' Loop through sheets
      For i = 1 To 10
    	' Sheet number in column A
    	With wshX.Range("A" & r)
    	  .Value = i
    	  .Interior.ColorIndex = 3
    	End With
    	' Set reference to source sheet
    	Set wsh = Worksheets(Format(i, "00"))
    	' Last used row
    	m = wsh.Range("B" & wsh.Rows.Count).End(xlUp).Row
    	' Copy range
    	wsh.Range("B2:F" & m).Copy Destination:=wshX.Range("B" & r)
    	' Adjust r
    	r = r + m - 1
      Next i
      ' Delete rows if column B is blank or contains "Sum:"
      Do While r > 0
    	If wshX.Range("B" & r) = "" Or wshX.Range("B" & r) = "Sum:" Then
    	  wshX.Range("A" & r & ":F" & r).Delete Shift:=xlShiftUp
    	End If
    	r = r - 1
      Loop
    End Sub

  12. #12
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    You are an absolute star! I really cannot thank you enough!

    The code does exactly what I asked for (oops) The numbers in column A are not required, and are not in the real file. I only put them there for reference so that it was easy to see where the data was coming from. Deleting the blanks and "sum:" in column B only needs to be within the output range of 4:end of data set, (not all of column B as I stated).

    I will attempt to understand the code so that I can adjust it.

    Many Thanks.

  13. #13
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hans,

    I have removed this section of code as not required.

    Code:
    ' Sheet number in column A
    	With wshX.Range("A" & r)
    	  .Value = i
    	  .Interior.ColorIndex = 3
    	End With
    I have changed this line of code to >4 so that the data stays in row 4 onwards.

    Do While r > 4

    I understand the code and it does what is required, however, my real data sheets are not named 01:10, they all have names. I only called them 01:10 for simplification, sorry! [duckquickly].

    How can I set an array of named worksheets and then say For Each worksheet in the array. I was hoping to do it that way so the array of source sheets can be expanded and reduced as required.

    Sorry for not being specific first time.

  14. #14
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Try

    Code:
    Sub FillX()
      Dim wshX As Worksheet
      Dim wsh As Worksheet
      Dim SheetName As Variant
      Dim r As Long
      Dim m As Long
      ' Set reference to target sheet
      Set wshX = Worksheets("x")
      ' Optional - clear target sheet
      wshX.Cells.Delete
      ' Starting row
      r = 4
      ' Loop through sheets
      For Each SheetName In Array("This", "That", "Other")
    	' Set reference to source sheet
    	Set wsh = Worksheets(SheetName)
    	' Last used row
    	m = wsh.Range("B" & wsh.Rows.Count).End(xlUp).Row
    	' Copy range
    	wsh.Range("B2:F" & m).Copy Destination:=wshX.Range("B" & r)
    	' Adjust r
    	r = r + m - 1
      Next SheetName
      ' Delete rows if column B is blank or contains "Sum:"
      Do While r > 0
    	If wshX.Range("B" & r) = "" Or wshX.Range("B" & r) = "Sum:" Then
    	  wshX.Range("B" & r & ":F" & r).Delete Shift:=xlShiftUp
    	End If
    	r = r - 1
      Loop
    End Sub

  15. #15
    Bronze Lounger
    Join Date
    Sep 2007
    Posts
    1,203
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Absolutely perfect! Thankyou, Thankyou, Thankyou!

    You can't learn a lot of this stuff from books, but I have learned a lot from you tonight (again). That small bit of code will have a lot of future use and I can adapt it for various purposes.

    2 questions:

    Are there any limitations to the amount of worksheets that can be entered into the array?
    Can the copy > destination be done as special values?

Page 1 of 2 12 LastLast

Posting Permissions

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