Looping/end on blank

[commanderkeen123]

hello,

so i've got a spreadsheet that i'm working on that i'm doing some automation for and i'm not sure where to go from here. i don't know too much about coding, but pick up a little here and there.

so what i have is 2 spreadsheets that i'm using to compare data and copy and paste the information found. there is a list of data in column E that i am copying and pasting into the "timestamp log" which has a macros that search for a variable in that workbook, if the variable is found the cell is copied. then "advisor info1" is activated and pasted in column H.

now i'm trying to avoid having to write the below coding for each and every cell in column E that has data to be found. is there a way to loop the process until a blank cell is found? like to have it search cell e2, e3, e4, e5... etc until it hits a cell with nothing in it? sometimes i have over 1000 cells in column E that i need to search through and trying to copy and paste out the below information 1000 times is very tedius and a waste. anyone have any ideas?

i'm not sure if i explained it clearly enough, let me know if you need a little more clarification

Range("e2").Select
Selection.Copy
Application.Workbooks.Open ("O:\~trading\~Reorg\Offer Tools\Files Needed\timestamp log.xls")
Windows("timestamp log.xls").Activate
Range("F1").Select
ActiveSheet.Paste
Application.Run "'timestamp log.xls'!findcell"
Windows("Advisor Info1").Activate
Range("h2").Select
ActiveSheet.Paste
Range("e2").Select
Selection.Copy
Windows("timestamp log.xls").Activate
Range("F1").Select
ActiveSheet.Paste
Application.Run "'timestamp log.xls'!findcell2"
Windows("Advisor Info1").Activate
Range("i2").Select
ActiveSheet.Paste

Range("e3").Select
Selection.Copy
Windows("timestamp log.xls").Activate
Range("F1").Select
ActiveSheet.Paste
Application.Run "'timestamp log.xls'!findcell"
Windows("Advisor Info1").Activate
Range("h3").Select
ActiveSheet.Paste
Range("e3").Select
Selection.Copy
Windows("timestamp log.xls").Activate
Range("F1").Select
ActiveSheet.Paste
Application.Run "'timestamp log.xls'!findcell2"
Windows("Advisor Info1").Activate
Range("i3").Select
ActiveSheet.Paste

i've included what i'm trying to avoid, which is having to copy and paste the set of code for each cell in column E. the line break is where the code repeats for the next cell

[royUK]

You can do without all those activation and select commands, like this

Please Login or Register  to view this content.

ItWhat does findcell do?

[commanderkeen123]

findcell searches column A for the variable in cell H1, if it finds it it copies the cell above it (findcell2 copies the cell below)

Sub findcell()
Dim rFind As Range

With Worksheets("Sheet3")
Set rFind = .Columns(1).Find(What:=.Range("H1").Value, After:=[a1] _
, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
rFind.Offset(-1, 0).Copy
Else
MsgBox .Range("H1").Value & " Could Not Be Found"
End If
End With
End Sub

i'm not sure i'm following with what you mean by not having all the activation and select commands. i'm not sure how else to select the cells with variables and to copy and paste them in the other workbooks. (still a n00b to alot of this, just picking it up as i go taking the long way around things)

[royUK]

You don't need to select the cells in VBA, see the code that I posted.

You need to rethink the coding, otherwise it will be really slow.

Attach an example workbook with what you expect to happen

[royUK]

You don't need to select cells in code, in fact you don't need to paste the value into a cell to find it.

[commanderkeen123]

i really don't have too much knowledge of vba coding, it's basically stuff that i've pulled from other projects and websites so it's a hodgepodge of coding that i don't always understand. alot of it i understand what it's doing so i can modify it to do what i want, but anything beyond that i'm having trouble finding ways of coding what i want.

i've attached 3 spreadsheets; Advisor Contact Info (where the first bit of code came from), example advisor info1 (example of data i'm using), timestamp log (workbook that searches email logs that i've exported through an outlook macro).

i put some comments on the spreadsheets that might help anyone understand what i'm trying to accomplish

Thank you soooo much for your help

[royUK]

I think the best thing to do would be to start from scratch and build the code one step at a time.

Your log would be much easier to use if it was a table of data rather than blocks of data.

Why noy describe the first step and start from there?

[commanderkeen123]

[edit]

ok i'm re-working the code a little try and simplify things, what i need to know is now how to get the below code to loop. what it does is takes cell H1 and checks to see if there are any cells that match in A:A. if it finds a match, it copies the cell above it, then pastes it in the next blank cell in column J.

i can get it to run for cell H1 fine, but how do i get it to check for H2,H3,H4...etc. ? basically to repeat the search/copy/paste for all cells in column H.

Public Sub LoopRow()
Dim c As Range

For Each c In Range("A:A")

If c.Value = Range("H1") Then
c.Offset(-1, 0).Copy
Columns("J:J").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Select
ActiveSheet.Paste
End If

Next c





End Sub

[commanderkeen123]

sorry double post it keeps getting messed up when i edit it, please delete this post

[commanderkeen123]

ok someone else had given me what i needed, this is what i'm using now:

Sub findcell2()
Application.ScreenUpdating = False
Dim c As Range
Dim a As Long
Dim x As Long
Dim y As Long
x = Sheets(1).Range("h" & Rows.Count).End(xlUp).Row
y = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row

For a = 1 To x
For Each c In Range("A1:A" & y)
If c.Value = Cells(a, "h").Value Then
c.Offset(-1, 0).Copy
Cells(a, "j").Activate
ActiveCell.PasteSpecial xlPasteAll
End If
Next c
Next a


End Sub