Find/match dates, and paste cellvalue in column X at the same row

[espenskeie]

Hello

I have column A in Workbook wbPort where I have listed all dates since 01.01.2005 until 2014

In workbook wb I have a column R where some of the cells has a value, and in column A I have the dates.

I would like to find the cell where there's a value (Column R), then take that date (Column A) and find the matching date in wbPort and paste the value in column X at the same row as date.

I've tried this code, but I'm not sure if this is any good way to solve it.

 For Each c In rng
            If Abs(c.Value) < 0.01 Then
            rowVal = c.Value.Row
            
            finddate = ws1.Range("A" & rowVal).Value
            Res = Application.Match(CLng(finddate), ws1.Range("A2:A3482"), 0)
            
                c.Value.Copy Destination:wsPort.Cells(Res + 1, X)
            End If
        Next

Kind regards
Espen

 

[JLGWhiz]

Hi Espen.

Using the Find method:

For Each c In rng
 If Abs(c.Value) < 0.01 Then
  Set Res = ws1.Range("A2:A3482").Find(Range("A" & c.Row).Value, LookIn:=xlValues)
   If Not Res Is Nothing Then
    c.Value.Copy wbPort.Sheets(1).Range("X" & Res.Row) 'edit sheet name
   End If
 End If
Next

Assumptions are that wbPort is an object variable for the second workbook and that sheet 1 is where the data is stored.

 

[espenskeie]

Thanks, it looks like it will work. But I now discovered that I don't know how to get those cells in my range to be selected...

I select multiple cells manually, and then run the code and the idea was that the code would pick up only the selected cells, and that these would be defined in "For each c in rng"

Here is what I got so far:

Set rng = ActiveCell


   
    Intersect(ActiveSheet.UsedRange, Columns(1)).Copy
    wsPort.Activate
    wsPort.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=True

Kind regards
Espen

 

[espenskeie]

Just an update:

This code works for my copy purpose:

Set rng = Selection


    rng.Copy


    wsPort.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=True

Have a nice evening

 

[JLGWhiz]

Thanks, it looks like it will work. But I now discovered that I don't know how to get those cells in my range to be selected...

I select multiple cells manually, and then run the code and the idea was that the code would pick up only the selected cells, and that these would be defined in "For each c in rng"

Kind regards
Espen

If you are making a munual selection and then want to loop through those items, you can use this approach:
Select several items on a worksheet, they can be contiguous or non-contiguous, makes no difference.

Sub example()  
For Each c In Selection
 MsgBox c.Value
Next
End Sub

 

[espenskeie]

Thanks. But if I want to copy those cells, and paste them horizontal to another worksheet should it be something like this:

Sub example() 
 For Each c In Selection
i = i + 1
wsPort.Cells(1, i).Value = c
NextEnd Sub

Kind regards
Espen

 

[JLGWhiz]

Thanks. But if I want to copy those cells, and paste them horizontal to another worksheet should it be something like this:

Sub example() 
 For Each c In Selection
i = i + 1
wsPort.Cells(1, i).Value = c
NextEnd Sub

Kind regards
Espen

I think it would need to = c.Value

 

[espenskeie]

Aha. Thanks a lot, I'll try it right away.

Kind regards
Espen