Remove empty cells and paste data from cell below

aquavion · September 19th, 2009, 04:44 AM

I am looking for advice on how to move cells containing data (columns D to K in EXAMPLE A), upwards so that the information lines
up with data already existing in columns A to C.

In the upper example data in cell D2 needs to move upto D1, E3 to E1, F4 to F1, G7 to G1 etc and K9 to K1.
Now, data on following rows is to move upto row 2 eg: E5 to E2, F6 to F2, G8 to G2.

The first 'block' of data starts at row 1 and finishes in this case at row 9.
The next 'block' of data starts at row 10 and finishes at row 18.
Row 19 shown is the start of the next 'block'. These 'blocks' may have upto 20 rows.

[EXAMPLE A]
...A.....................B..................C..... .......D...................E....................F. .........G...........H ..........I...........J.........K
----------------------------------------------------------------------------------------------------------------------
01.28-00-340.....Fuel system....Tests
02................................................ ..........Fuel system
03................................................ ..............................S280M AAAA1
04................................................ .................................................. .C0411
05................................................ ..............................S280M ABBB2
06................................................ .................................................. C0412
07................................................ .................................................. ...............PE.........FH............600
08................................................ .................................................. ...............PE.........FH...................... .0
09................................................ .................................................. .................................................. .............ALL
10.28-01-347.....Fuel drain.....Tests
11................................................ ..........Fuel system
12................................................ ..............................S280M BBBB5
13................................................ .................................................. .C0427
14................................................ ..............................S280M XCCC6
15................................................ .................................................. C0512
16................................................ .................................................. ...............PE.........FH............450
17................................................ .................................................. ...............PE.........FH...................... .0
18................................................ .................................................. .................................................. .............VERSION
19.28-01-876.....Fuel valve....Tests
etc etc

The output result should resemble EXAMPLE B

[EXAMPLE B]
================================================== ================================================== ==================
...A.....................B..................C..... .......D.....................E.................... ......F...............G...........H ..........I...........J.........K
----------------------------------------------------------------------------------------------------------------------
01.28-00-340.....Fuel system....Tests......Fuel system.....S280M AAAA1....C0411........PE.........FH............600 ..............ALL
02................................................ ................................S280M ABBB2.....C0412........PE.........FH.............. .....0
03.28-01-347.....Fuel drain.......Tests.....Fuel system.....S280M BBBB5....C0427........PE.........FH............450 ..............VERSION
04................................................ .................................S280M XCCC6....C0512........PE.........FH............... ...0
05.28-01-876.....Fuel valve.......Tests
etc etc

Hope this makes sense - I am reasonably new to Excel VBA but cannot see how I can acheive this.
I don't know if I should tackle this with a for/next loop or what would be the best.

ANY pointers, help or even hints would be very greatly appreciated.

PS the decimal points are just there to line stuff up in this forum posting

allenm · September 24th, 2009, 06:35 PM

There seems to be certain lines that don't get inherited to the last listed 'item' in a list. For instance, the 0 inherits to the model S280M ABBB2 for Fuel System but the ALL beneath that in another row gets inherited to item S280M AAAA1.

Given that not all values inherit the same to a given record means that you'd have to remember each line in an array and return to that line to place data as the lines progressed determining if a new record happens by a value in column A for instance would end the previous record as an assumption. Do all column K entries inherit to the topmost of the grouping? Does J always inherit to the lowest filled in E column? As it stands there is not enough information to even write a decent mock up of what you may want.

The easiest way would be to have a source sheet and a target sheet and move data from one to the other, tracking the important lines in both with a pointer. How complex this is really depends on your actual data and how many convoluted exceptions you need to put in.

If you can give a link to an actual datasheet then explain exactly what the code needs to do and what you're having the problem with it doing and we'd be better able to help you complete your code.

aquavion · September 25th, 2009, 04:56 PM

Thanks Allenm for your reply.

I have a spreadsheet that more clearly identifies the subject but there is no way to attach files on this forum.

You happened to mention "If you can give a link to an actual datasheet then ....." but I don't know where to place the sheet on the internet so that I can link to it?

Best regards

aquavion · September 26th, 2009, 04:48 AM

Hi Allenm

Please find a link to the example sheet at

http://www.thecodecage.com/forumz/me...mpty-cell.html

Hope that linking to another forum is permitted, as it was the only way I could post the .xls file.

Regards

allenm · September 28th, 2009, 09:52 AM

Okay, this should accomplish what you need to do. The problem comes in where you don't want every column floating to the topmost for each record. These you need to treat as a group for moving so it makes it difficult to write a function to just bubble each column up to the topmost for a record to allow you to make cell movement a function call. A - C get moved as a group and G - J both need moved as a group. Instead I made the finding of the topmost empty cell a function and moved the cells themselves within main.

Code:

Public Sub MakeRecords()

'Merges cells upwards making main and child records, assembling related data on same line
  Dim oSource As Worksheet, oTarget As Worksheet, iSrcRow As Long, iSrcRowOn As Long
  Dim iTgtRow As Long, iLastTgtRow As Long, iTtlSrcRows As Long, iEmptyCellRow As Long
  Dim iNextEmptyCell As Long
  Set oSource = Worksheets("Data")
  Set oTarget = Worksheets("Target")
  iTtlSrcRows = oSource.UsedRange.Rows.Count
  iSrcRow = 1 'Set this equal to the row where first line of data starts on Data sheet
  iTgtRow = 1 'Set this equal to where you want the first record to be placed on Target sheet
  iLastTgtRow = iTgtRow - 1 '1 always gets added when detecting "New" record including for 1st record
  For iSrcRowOn = iSrcRow To iTtlSrcRows
    With oSource
    'Detects a "new" record by value in column A.  Column A - C move as a group.
      If .Cells(iSrcRowOn, 1).Value & "" <> "" Then
        iLastTgtRow = iLastTgtRow + 1
        iTgtRow = iLastTgtRow
        oTarget.Cells(iTgtRow, 1).Value = .Cells(iSrcRowOn, 1).Value
        oTarget.Cells(iTgtRow, 2).Value = .Cells(iSrcRowOn, 2).Value
        oTarget.Cells(iTgtRow, 3).Value = .Cells(iSrcRowOn, 3).Value
      End If
    'Detects "System" row.  If 1 system exists then moves "top" line down before placing value
      If .Cells(iSrcRowOn, 4).Value & "" <> "" Then
        If oTarget.Cells(iTgtRow, 4).Value & "" <> "" Then
          iLastTgtRow = iLastTgtRow + 1
          iTgtRow = iLastTgtRow 'Moves highest level line down
        End If
        oTarget.Cells(iTgtRow, 4).Value = .Cells(iSrcRowOn, 4).Value
      End If
    'Moves E up to last blank row or iTgtRow which ever is lower if value exists
      If .Cells(iSrcRowOn, 5).Value & "" <> "" Then
        iEmptyCellRow = FindTopMostCell(oTarget, iLastTgtRow, iTgtRow, 5)
        oTarget.Cells(iEmptyCellRow, 5).Value = .Cells(iSrcRowOn, 5).Value
        If iEmptyCellRow > iLastTgtRow Then iLastTgtRow = iEmptyCellRow
      End If
    'Moves F up to last blank row or iTgtRow which ever is lower if value exists
      If .Cells(iSrcRowOn, 6).Value & "" <> "" Then
        iEmptyCellRow = FindTopMostCell(oTarget, iLastTgtRow, iTgtRow, 6)
        oTarget.Cells(iEmptyCellRow, 6).Value = .Cells(iSrcRowOn, 6).Value
        If iEmptyCellRow > iLastTgtRow Then iLastTgtRow = iEmptyCellRow
      End If
    'Moves G - J up as a group to last blank row or iTgtRow which ever is lower if value exists
      If .Cells(iSrcRowOn, 7).Value & "" <> "" Then
        iEmptyCellRow = FindTopMostCell(oTarget, iLastTgtRow, iTgtRow, 7)
        oTarget.Cells(iEmptyCellRow, 7).Value = .Cells(iSrcRowOn, 7).Value
        oTarget.Cells(iEmptyCellRow, 8).Value = .Cells(iSrcRowOn, 8).Value
        oTarget.Cells(iEmptyCellRow, 9).Value = .Cells(iSrcRowOn, 9).Value
        oTarget.Cells(iEmptyCellRow, 10).Value = .Cells(iSrcRowOn, 10).Value
        If iEmptyCellRow > iLastTgtRow Then iLastTgtRow = iEmptyCellRow
      End If
    'Moves K up to last blank row or iTgtRow which ever is lower if value exists
      If .Cells(iSrcRowOn, 11).Value & "" <> "" Then
        iEmptyCellRow = FindTopMostCell(oTarget, iLastTgtRow, iTgtRow, 5)
        oTarget.Cells(iEmptyCellRow, 11).Value = .Cells(iSrcRowOn, 11).Value
        If iEmptyCellRow > iLastTgtRow Then iLastTgtRow = iEmptyCellRow
      End If
    End With
  Next
  MsgBox "Finished Processing", , "Completion Notification"

End Sub

Private Function FindTopMostCell(oTarget As Worksheet, iLastTgtRow As Long, iTgtRow As Long, _
iColOn As Long) As Long

'Locates first empty cell between iLastTgtRow and iTgtRow
  Dim iNextEmptyCell As Long, iEmptyCellRow As Long
  If oTarget.Cells(iLastTgtRow, iColOn).Value & "" <> "" _
    Then iEmptyCellRow = iLastTgtRow + 1 _
    Else iEmptyCellRow = iLastTgtRow
  If iEmptyCellRow = 1 Then iNextEmptyCell = 1 Else iNextEmptyCell = iEmptyCellRow - 1
  Do While oTarget.Cells(iNextEmptyCell, iColOn).Value & "" = "" And iEmptyCellRow > iTgtRow
    iEmptyCellRow = iEmptyCellRow - 1
    If iEmptyCellRow = 1 Then iNextEmptyCell = 1 Else iNextEmptyCell = iEmptyCellRow - 1
  Loop
  FindTopMostCell = iEmptyCellRow

End Function

Hope this helps point in the right direction.