Repeat MAcro Till end of File 1

[Smoothas]

Hello,
I have written a HUGE macro to import a RTF file and adjust colunms etc, but what I am now looking to do is traverse this spreadsheet, and append the content of certains cells to the cell above, then delete the orignal cell, till the end of the data is reached.
I Done part of that( however ugly it may look ), but I'm having trouble getting it to loop till the end of the file (which can be / is a variable length ).
This is the code I have so far, which stops after the first "find". If I try and launch it again, it just add as blank space onto the end of the previous append, and stops in the same position

Sub findblankmovetoleft()
Dim R As Range
Dim All_Data As Range

Set All_Data = Range("a:a")


For Each R In All_Data
If R = "" Then
R.Select
Selection.Offset(0, 1).Select
ActiveCell = Selection.Offset(-1, 0) + " " + ActiveCell
Selection.Offset(-1, 0) = ""
ActiveCell.Cut
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(2, -1).Select
If ActiveCell = "" Then
Selection.Offset(1, -1).Select
End If
Exit For
End If
Next R
End Sub

Any ideas as to what I can do to recifiy this ?

Many Thanks in advance

Gerald

 

[SkipVought]

Please post an example of the data that you are massaging and what you hope the result to be.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[AnotherHiggins]

To answer your question directly, you can set the range to just populated cells. You'll need to find the last populated row. There are several ways to do this (and two FAQs in this forum on the subject). I'll suggest this:

intLstRow = Range("A" & Sheets(1).Rows.Count).End(xlUp).Row
Set All_Data = Range("a1:a" & intLstRow )

I'd suggest getting rid of all the "Select"s, at the very least. I think the logic can be condensed as well.

What exactly are you trying to do?


[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[mscallisto]

have you tried the debug method of stepping through your code line by line (F8) to check if variables and values are what you expect them to be?

and yes answering Skips request would help tremendously.

sam

 

[SkipVought]

Assuming assumptions...

like your data (in shorthand) looks like this...
[tt]
a1 b1 c1

a3 b3 c3 d3

a5 b5

...
[/tt]

Sub findblankmovetoleft()
    Dim R As Range, s As String, C As Range, lRow As Long
    Dim All_Data As Range
    
    Set All_Data = Range([A1], Cells(Cells.Rows.Count, "A").End(xlUp))
    
    For Each R In All_Data
        If R = "" Then
            If lRow > 0 Then
                Cells(lRow, "A").Value = s
            End If
            s = ""
        Else
            If s = "" Then lRow = R.Row
            For Each C In Range(R, R.End(xlToRight))
                s = s & " " & C.Value
            Next
        End If
    Next R
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Smoothas]

HEllo, Yes, sorry, the data source would have been usefull in the original post. Sorry about that.
A truncated form of the spreadsheets look like this :-

Client id Client Name
LLL000A Chris Croc
Limited
BBFV08 The Independent
Company
COG599 Mrs Bun Bakerson
GER0001B Yet another company
Inc

What I was after the code to do was look down column a, find a blank cell,move over to column B on the same row. If that cell is blank also, move down a row, and back a column and search again for the next blank cell.
If Cell B is populated, truncate it to the cell above, then delete the orignal cell, then move on to find the next blank cell, till it reachs the end of the spreadsheet.

I also have a column H with has a similar problem. This has "wrapped" notes over serval lines someone, and I need them appending to the cell above. I assumed I could cludge the code and make it run in reverse.

Column G Column H
Subject Note

Call user
Buy parts Some information
Call user
Road Trip Different information
Indepth review This data needs to be
one line, but due to the
lenght of the text it's on three
Cal User more data

so that it reads

Column G Column H
Subject Note

Call user
Buy parts Some information
Call user
Road Trip Different information
Indepth review This data needs to be one line, but due to..
Cal User more data

Ive attched a link to a test file, if needed

 

[Smoothas]

Hi SkipVought, thanks for the code. I tried it, but wasn't exactly what I was looking for (but that was down to my orginal, vague posting).
I'm trying to get the output to look like the attached file.

 

[SkipVought]

I checked your test workbook and it seems my code is the essence of the solution.

Have you tried playing with it to get it to do something a little different?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Well I checked the Needstolooklike[1].xls, and realize that I was mislead by the NAME of your procedures, findblankmovetoleft. moveup would have been more descriptive.

So here's the drill. As you loop down the list (Column A), the populated cells are the rows where the data belongs. The [BLANK] cells (column A) have data in one or more columns that must be appended to the value in the populated row above.

The c for...next loop hits ALL the columns that must be processed for any particular populated row as you continue down the r for...next loop with [BLANK] r.value. So when you encounter a c.value that is NOT [BLANK}, it must be concatenated with the value in the populated row and the c column. Pretty simple!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Smoothas]

Hello again,

Thanks for the help and explanation,

With a little bit of frankensteining, I got it working for column B :-

Sub findblankmovetoleft3()
Dim R As Range
Dim All_Data As Range

Set All_Data = Range([A1], Cells(Cells.Rows.Count, "A").End(xlUp))
For Each R In All_Data
If R = "" Then
R.Select
Selection.Offset(0, 1).Select
ActiveCell = Selection.Offset(-1, 0) + " " + ActiveCell
Selection.Offset(-1, 0) = " "
ActiveCell.Cut
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(2, -1).Select
Else
If ActiveCell = "" Then
Selection.Offset(1, -1).Select
End If
End If
Next R
End Sub

Ugly code and "fat" logic, Yes, but...Job Done. Many Thanks again

I'm now trying to getting to work backwards ( ie, from the bottom of the sheet, upwards ) on Column H.

 

[SkipVought]

Using the select method, as you are doing, is clunky and inefficient.

If you use my example as the basis for your process, you will not have to get it, "working for column B" and then some other column. It will work for ALL columns.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

My code slightly tweeked...

Sub moveUP()
    Dim R As Range, s As String, C As Range, lRow As Long
    Dim All_Data As Range
    
    Set All_Data = Range([A1], Cells(Cells.Rows.Count, "A").End(xlUp))
    
    For Each R In All_Data
        If R = "" Then
            For Each C In Range(R, R.End(xlToRight))
                If C.Value <> "" Then
                    With Cells(lRow, C.Column)
                        .Value = .Value & " " & C.Value
                        C.Clear
                    End With
                End If
            Next
        Else
            lRow = R.Row
        End If
    Next R
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Smoothas]

hi Skip,
Your right, thats great.

Fantastice.

Thank you very much.
I hope this thread helps someone else as much as I'ts helped me.

 

[AnotherHiggins]

It will run faster if you don't use Select, especially for large sets of data.

In the following, I've taken the liberty of deleting the rows that wind up being empty. If you don't want to do that, you can just get rid of the line I've bolded.

Sub Test()
    intLstRow = Range("B" & Rows.Count).End(xlUp).Row

    For R = intLstRow To 2 Step -1
        With Range("B" & R)
            If .Offset(, 1).Value = "" Then
                .Offset(-1) = Trim(.Offset(-1).Value & " " & .Value)
                .Offset(-1, 6) = Trim(.Offset(-1, 6).Value & " " & .Offset(, 6).Value)
                [b].EntireRow.Delete    [green]'Delete empty row[/green][/b]
            End If
        End With
    Next R
End Sub

(Edit: I was called away from my desk before submitting and I now see that Skip has already posted back. But I'll submit anyway just for an alternative.)

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[SkipVought]

Better not delete entire row until ALL items in that row are processed.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}