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

T

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

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
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>​
 
Upvote 0
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.
 
Upvote 0
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>​
 
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂ ...
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA Highlight cell if contains specific text
Replies
4
Views
84
DanteAmor
DanteAmor
B
  • Question
Delete content of cells / move up remaining data in multiple worksheets based on a range of blank cells in each worksheet
Replies
0
Views
325
Blanchetdb
B
WildBurrow
  • Question
Copy/Paste data to next empty row within a range - WITHOUT shifting subsequent rows up
Replies
0
Views
100
WildBurrow
WildBurrow
muhammad susanto
  • Solved
VBA ; Clear Content From C2 to E8 and Move up
2
Replies
13
Views
516
muhammad susanto
muhammad susanto
C
  • Solved
VBA: Moving Cell content to specific column if empty cell within range
Replies
7
Views
377
Fluff
Fluff

Forum statistics

Threads
1,214,409
Messages
6,119,339
Members
448,888
Latest member
Arle8907

Share this page

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
Back
Top