Macro to filter two columns

[Polo78 Lacoste]

I have two columns, for simpicity I'll name them column A and Column B.

To illustrate my data on sheet1:

Column A header column B header
Record 1 <blank>
<blank> 05/20/06 Record 1 related info-A
<blank> 06/29/06 Record 1 related info-B
Record 2 <blank>
<blank> 06/29/06 Record 2 related info-A
<blank> 03/01/07 Record 2 related info-B
<blank> 04/05/07 Record 2 related info-C
<blank> 06/22/08 Record 2 related info-D
Record 3 <blank>
<blank> 01/29/08 Record 3 related info-A
<blank> 07/29/08 Record 3 related info-B
<blank> 02/27/09 Record 3 related info-C

Note, <blank> means empty cell

So basically I need a macro to get the latest entry info from column B
and moved to the <blank> cell adjacent to column A for each item
existing in column A
and delete all other blank rows in column A.

So after the macro, it should look like:

Column A column B
Record 1 06/29/06 Record 1 related info-B
Record 2 06/22/08 Record 2 related info-D
Record 3 02/27/09 Record 3 related info-C


Note, all items in column A and column B are dynamic and cannot specify
a fixed range.


Any help on hard coding to get me started would be appreciated.


Thank you.


*** Sent via Developersdex http://www.developersdex.com ***

 

[Bernie Deitrick]

Polo78,

Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub Macro1()
Dim i As Integer

With Columns("B:B").SpecialCells(xlCellTypeBlanks)
For i = 1 To .Areas.Count - 1
.Areas(i)(1).Formula = "=" & .Areas(i + 1)(0).Address
Next i
..Areas(.Areas.Count)(1).Formula = _
"=" & IIf(.Areas(.Areas.Count)(3) = "", _
.Areas(.Areas.Count)(2).Address, _
.Areas(.Areas.Count)(2).End(xlDown).Address)
End With
Columns("B:B").Copy
Columns("B:B").PasteSpecial xlPasteValues
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

 

[Polo78 Lacoste]

Thank you so much!! Coding was flawleses.

Thank you in advance.

Newbie to VBA.

*** Sent via Developersdex http://www.developersdex.com ***

 

[Polo78 Lacoste]

I have another dilemma, hope you help me out on this one. Original data
has 4 columns, driven by column A. This is somewhat a transpose but on
multiple columns.

Before macro run

Column A column B Column C Column D Column E
Client 1 item qty date1 date2
<blank> item2 qty date1 date2
<blank> item3 qty date1 date2
Client 2 item qty date1 date2
<blank> item2 qty date1 date2
Client 3 item qty date1 date2
<blank> item2 qty date1 date2
<blank> item3 qty date1 date2
<blank> item4 qty date1 date2


After macro run

Column A Column F
Client 1 item-qty-date; item2-qty-date2; item3-qty-date2
Client 2 item-qty-date; item2-qty-date2;
Client 3 item-qty-date; item2-qty-date2; item3-qty-date2;
item4-qty-date2


After the macro is finished, any blank data in column A should be
deleted. Also Column F should be appended to Column A-E (totalling 6
columns when report is done).

Need VBA macro coding to help out and get started.

Thank you in advance.

Newbie to VBA.

*** Sent via Developersdex http://www.developersdex.com ***

 

[Per Jessen]

Hi

Try this:

Sub bbb()
FirstRow = 2 'Headings in row 1
LastRow = Range("B" & Rows.Count).End(xlUp).Row

For r = FirstRow To LastRow
If Cells(r, 1) = "" Then
LastCol = Range("A" & TargetRow).End(xlToRight).Column
Cells(r, 2).Resize(1, 4).Cut Destination:=Cells(TargetRow,
LastCol + 1)
Else
TargetRow = r
End If
Next
Range("A1", Cells(TargetRow, 1)).SpecialCells
(xlCellTypeBlanks).EntireRow.Delete
End Sub

Regards,
Per

 

[Polo78 Lacoste]

I forgot to mention that all the columns on F and after, should all be
in one cell, so when there is a vlookup on a column A, column F has all
the data. Im trying to figure out how to concat the cells data. You did
an excellent job by the way.

Thank you in advance.

Newbie to VBA.

*** Sent via Developersdex http://www.developersdex.com ***

 

[Bernie Deitrick]

Try this version:

Sub bbb2()
FirstRow = 2 'Headings in row 1
LastRow = Range("B" & Rows.Count).End(xlUp).Row


For r = FirstRow To LastRow
If Cells(r, 1) = "" Then
LastCol = Range("A" & TargetRow).End(xlToRight).Column
myVal = ""
myVal = Cells(r, 2).Text
For i = 1 To 3
myVal = myVal & "-" & Cells(r, 2 + i).Text
Next i
Cells(TargetRow, LastCol + 1).Value = myVal
Else
TargetRow = r
End If
Next
Range("A1", Cells(TargetRow, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub



HTH,
Bernie
MS Excel MVP

 

[Polo78 Lacoste]

Bernie,
Im trying to decifer the coding that you did, so I can try to understand
your coding and learn VBA more..

Basically, Im still having a problem with the if statement that you
place

If Cells(r, 1) = "" , the problem is, if the client has only one record,
it skips the row and does not place the contents on column B, C, D, on
the column F.

Also, I noticed the items are still not being placed on column F. I
cannot have more than 6 columns, total, regardless of how many items
there are for each client. Pls advise what is the vba function/formula
to concat and hold myVal to contain all previous items, so when the data
is ready to be copied, it will place all the data on column F.

Thank you again. BTW, your coding is awesome!



Thank you in advance.

Newbie to VBA.

*** Sent via Developersdex http://www.developersdex.com ***

 

[Bernie Deitrick]

Sub bbb3()
FirstRow = 2 'Headings in row 1
LastRow = Range("B" & Rows.Count).End(xlUp).Row

For r = FirstRow To LastRow
If Cells(r, 1) <> "" Then
TargetRow = r
addon = False
Else
addon = True
End If
LastCol = 6
myVal = ""
myVal = Cells(r, 2).Text
For i = 1 To 3
myVal = myVal & "-" & Cells(r, 2 + i).Text
Next i
Cells(TargetRow, LastCol).Value = _
Cells(TargetRow, LastCol).Value & IIf(addon, "; ", "") & myVal
Next r
Range("A1", Cells(TargetRow, 1)) _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


HTH,
Bernie
MS Excel MVP