Excel VBA Macro

[Andrew Slentz]

Hi,

I am trying to get a macro to work that will take the contents of column
B and copy it to the rows below until there is another piece of data in
column B. That new data is then copied to all subsequent rows until
there is more data in B. It should also delete all rows which
originally contained data in column B.

Any ideas????

Example:
ORIGINAL:
A B C
1 Olive
2 Data1 Smooth
3 Data2 Rough
4 Data3 Smooth
5 Green
6 Data4 Rough
7 Data5 Sticky

DESIRED:
A B C
1 Data1 Olive Smooth
2 Data2 Olive Rough
3 Data3 Olive Smooth
4 Data4 Green Rough
5 Data5 Green Sticky

Thanks in advance!!!

 

[keepITcool]

try:
Sub FillNClean()
Dim i&, r As Range

Set r = [a1].CurrentRegion
With r
With .Columns(2).SpecialCells(xlCellTypeBlanks)
For i = .Areas.Count To 1 Step -1
With .Areas(i)
With .Offset(-1).Resize(.Rows.Count + 1)
.FillDown
Intersect(r, .Rows(1).EntireRow).Delete
End With
End With
Next
End With
End With

End Sub


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Dave Peterson]

Another method:

Option Explicit
Sub testme01()

Dim myRng As Range
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("b2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "No gaps!"
Exit Sub
End If

myRng.FormulaR1C1 = "=r[-1]c"

With .Range("b:b")
.Value = .Value
End With

.Range("a:a").AutoFilter field:=1, Criteria1:=""
.AutoFilter.Range.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete

End With

End Sub

Essentially, it selects column B and does edit|goto|special|blanks and fills
those cells with the value above. Then it filters for blanks in column A and
throws those rows away.

Debra Dalgleish has this first portion described at:
http://www.contextures.com/xlDataEntry02.html

 

[Andrew Slentz]

Now I am really lost... That last one removed all of the values in
colum b and left only the date in the other columns... Any ideas???

Andrew

 

[Andrew Slentz]

Now I am really lost... That last one removed all of the values in
colum b and left only the date in the other columns... Any ideas???

Andrew

 

[Dave Peterson]

It worked with your test data. Is your layout different in your real data?

 

[Andrew Slentz]

I guess I should add one more important note... because of the way the
data is saved the values in column B are not really blank but are ""
instead...

Thanks so much!

Andrew

 

[Dave Peterson]

What does "" mean?

Does this mean that it was the results of a formula =if(...,"","xxx") and you
converted to values?

Or does it mean that you really have ="" in the cell--or even "" in the cell
(but that would show????).

I'm still confused, but I'm gonna guess that it's the leftover bits from a
formula converted to a value.

I'd select column B and do this:
Edit|Replace
what: (leave blank)
with: $$$$$ (some unique string)

Then do it once more:
edit|replace
what: $$$$$ (same string as before)
with: (leave blank)

This converts that detritus to actual blanks.

Then run that macro.

If you have to do this filling to lots of different worksheets, you could record
a macro when you do the edit|replaces and add that to the top of that suggested
code.

======
Do all this stuff against a copy of your workbook--or don't save! (But I bet
you've learned your lesson on that by now!)

 

[Kelly n español]

Andrew,

I think that many people may be misunderstanding the layout of you
worksheet due to the limitations of trying to post your columns an
rows here in the forum.

Of course, maybe I misunderstand also!

Okay, for the sake of avoiding all misunderstanding, let me ask if thi
is correct....

Your COLUMN B, looks like this, am I right:

Olive
Data1
Data2
Data3
Green
Data4
Data5

So, B1 = "Olive", B2 = "Data1", B5 = "Green", B6 = "Data4"

Is that correct??

If so, then here is the macro that I propose:


Code
-------------------

Sub Andrews_Data()

For x = 1 To 500

If StrComp(Left(Trim(Cells(x, 2)), 3), "dat", vbTextCompare) <> 0 Then

ColorName = Trim(CStr(Cells(x, 2)))
Cells(x, 2).Value = ""

Else

If Trim(Cells(x, 2).Value) <> "" Then
Cells(x, 2).Value = Trim(CStr(Cells(x, 2).Value)) & " " & ColorName
End If

End If

Next

End Sub

-------------------


Please note that the macro above does not contain any "error handling,
or any instructions for what the macro should do if any of the data i
column B doesn't fit your pattern at all.

Also, I have simply told it to go from B1 down to B500, which i
completely arbitrary.

My "laziness" about errors and choosing how many rows is due to th
following:

I hope you can first confirm for me whether this macro produces
result which is at all similar to what you need. There's no point i
me making a macro that handles all types of eventualities if I a
totally off-base about your situation.

I am attaching a file with my own "dummy" data so you can see what
was thinking

Attachment filename: andrews_data.xls.zip
Download attachment: http://www.excelforum.com/attachment.php?postid=62022