VBA Loop to find cell, move contents up, then clear old contents

[TheBarman]

Hello guru's.

I have always struggled with loop...do
and I need to do more study on this theory.


CONCEPT:

code that allows me to loop through a worksheet
and move Manager Name (find d.value) to 2 rows above Store Number (find c.value).

The data sheet has various rows in-between c.value and d.value

Whilst the data is all in column "A",
I thought it would be easier to move the entire row instead of cell "A" (but not fussed).

This code seems to always loop back to A12 and not move on to A19, A56 etc and could be .findnext


CELL DATA:
*********************************************************************
A12 = <blank><blank>
A13 = Company Division Name (various text)
A14 = Store Number & Name (always starts with text "No." then text filler)
A15 + A... = general text comment (can be multiple rows)
A16 = Manager Name (always starts with text "Emp No:" then text filler)

Move A16 to A12, then clear A16 contents

*********************************************************************
A19 = <blank><blank>
A20 = Company Division Name (various text)
A21 = Store Number & Name (always starts with text "No." then text filler)
A22 + A... = general text comment (can be multiple rows)
A26 = Manager Name (always starts with text "Emp No:" then text filler)

Move A26 to A19, then clear A26 contents

*********************************************************************
A56 = <blank><blank>
A57 = Company Division Name (various text)
A58 = Store Number & Name (always starts with text "No." then text filler)
A59 + A... = general text comment (can be multiple rows)
A65 = Manager Name (always starts with text "Emp No:" then text filler)

Move A65 to A56, then clear A65 contents

*********************************************************************
and so on.....

Dim c As Range, d As Range
Lrow = Cells(Rows.Count, 1).End(xlUp).Row ' Gets the last populated row in Col A


    With Worksheets("Import").Range("A2:A" & Lrow)


     Set c = .Find("No.*", LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext)
     If Not c Is Nothing Then
        'firstAddress = c.Address   (I removed this to find the row number)
        firstAddress = c.Row


     Set d = .Find("Emp No:*", LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext)
     If Not d Is Nothing Then
        'SecondAddress = c.Address   (I removed this to find the row number)
        SecondAddress = d.Row


        Do
            Range("A" & firstAddress - 2).Value = d
            Range("A" & SecondAddress).ClearContents


Set c = .FindNext(c)
Set d = .FindNext(d)


        If c Is Nothing Then
            GoTo DoneFinding
        End If
        Loop While Not c Is Nothing And c.Address <> firstAddress


      End If
        End If
DoneFinding:


End sub

</blank></blank></blank></blank></blank></blank>

 

[My Aswer Is This]

I see not trend here.

It looks like if a cell in column A is empty and another cell has

Emp No as first six charters then move this cell up to the empty cell.

So in first case move A16 to A12 then clear A16

Well now that A16 is clear why not move next cell with

Emp No to A16

That would show a trend.​

_{^{<strike>
</strike>}}​

 

[TheBarman]

Hi,
every day the data changes and is not consistent in the rows

The above was just today's sample.
Tomorrow could be A23 to A17 : A41 to A33.

The only constant is "No." and "Emp No:" to identify the various ranges.

 

[My Aswer Is This]

You said:

The only constant is "No." and "​

Emp No:" to identify the various ranges.​

What is:

"No."

I thought you said empty cell.

Here is what you said earlier:

A19 =​

_{^{<strike>
</strike>}}​

 

[TheBarman]

"No." is the start of the text string

 

[TheBarman]

Data changes every day so they are never the same rows


VBA concept

find row 14 ("No.xxxxxxx")
Copy row 16 ("Emp No:xxxxx")
Paste into row 12 (row 14-2)
Clear row 16 contents

Move onto next find of "No."
find row 21 ("No.xxxxxxx"
Copy row 26 ("Emp No:xxxxx")
Paste into row 19 (row 21-2)
Clear row 26 contents


[TABLE]
<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[TH]C[/TH]
[/TR]
</thead><tbody>[TR]
[TD="align: center"]12[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]13[/TD]
[TD]Eastern Retail[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]14[/TD]
[TD]No.8 South-West Marketing[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]15[/TD]
[TD]TEXT[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]16[/TD]
[TD="bgcolor: #FFFF00"]Emp No: 10485 Roger Flemington[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]17[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]18[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]19[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]20[/TD]
[TD]Maintenance[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]21[/TD]
[TD]No.4 Head Office[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]22[/TD]
[TD]TEXT[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]23[/TD]
[TD]TEXT[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]24[/TD]
[TD]TEXT[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]25[/TD]
[TD]TEXT[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]26[/TD]
[TD="bgcolor: #FFFF00"]Emp No: 11456 Dean Tupper[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]27[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]28[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]29[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]
[CENTER][COLOR=#161120][B]Import[/B][/COLOR][/CENTER]
[img]

 

[TheBarman]

Hello,
I'm so sorry to do this, but I was just wondering if anyone could review the above code.
I think My Aswer Is This was just asking questions
that may have looked like this post was answered.
Thank you.

 

[lrobbo314]

Let me know if this does the trick.

Sub moveEm()
Dim r As Range: Set r = Range("A12:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim ar() As Variant: ar = r.Value
Dim LR As Long: LR = 0


For i = 1 To UBound(ar)
    If ar(i, 1) = vbNullString Then LR = i
    If InStr(ar(i, 1), "Emp No") > 0 Then
        ar(LR, 1) = ar(i, 1)
        ar(i, 1) = vbNullString
    End If
Next i


r.Value = ar
End Sub

 

[TheBarman]

Hi Robbo
This has worked.

Thank you very much for your time and effort.

 

[lrobbo314]

───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂ ...
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂