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

TheBarman

New Member
Joined
Jun 10, 2009
Messages
16
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.....


Code:
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>
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,556
Office Version
  1. 2013
Platform
  1. Windows
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

New Member
Joined
Jun 10, 2009
Messages
16
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

Well-known Member
Joined
Jul 5, 2014
Messages
17,556
Office Version
  1. 2013
Platform
  1. Windows
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

New Member
Joined
Jun 10, 2009
Messages
16

ADVERTISEMENT

"No." is the start of the text string
 

TheBarman

New Member
Joined
Jun 10, 2009
Messages
16
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]
 
Last edited:

TheBarman

New Member
Joined
Jun 10, 2009
Messages
16

ADVERTISEMENT

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

Well-known Member
Joined
Jul 14, 2008
Messages
3,138
Office Version
  1. 365
Platform
  1. Windows
Let me know if this does the trick.

Code:
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
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,138
Office Version
  1. 365
Platform
  1. Windows
───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂ ...
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂
 

Watch MrExcel Video

Forum statistics

Threads
1,129,505
Messages
5,636,717
Members
416,936
Latest member
Saurabh786

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top