VBA : Looking for a variable date into a different sheet, Please some help)

[Bruno125sx]

Hi There,
Please, anyone can help me with a VBA code.
Purpose is : Finding the variable date form "Sheet2" "F13" into my Row 13 "sheet 7" (Col F to HP)
get the location Cells(Y, x) so i can from this Cell (Y, x) copy and past some selected data do "sheet2".

This is a part of a macro attached to a button.

So far i did this but i guess im a bit far to get what i want (

Sub CopyTimeLine()

    Dim ws As Worksheet
    Dim ws7 As Worksheet
    Dim rng As Range
    Dim targetDate As Range

    'change sheet1 to suit
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    Set ws7 = ThisWorkbook.Worksheets("Sheet7")
  
    'change address of your cell with target date
    Set targetDate = ws2.Range("F13")

    'tries to find target date in first row
    Set rng = ws7.Range("13:13").Find(What:=targetDate, LookAt:=xlWhole, MatchCase:=False)

    If rng Is Nothing Then
        'if nothing found - search for last non empty column
       MsgBox "not Found"
        MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
      
    Else
       Get the found Cells(Y, x) to include in the following.

'Sheets("7").Select
    'Range(Cells(Y, x+1), Cells(Cells(14, 6) + 50, Cells(14, 6) + 59)).Select
    'Selection.Copy
    'Sheets("2").Select
    'Range("F14:G14").Select
    'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    'True, Transpose:=False
      
    End If
End Sub

i hope you guys can understand what i hope to achieve. if there is a simple way i would be glad to hear.

thanks a lot.

 

[PCosta87]

Hi,

Welcome to the forum

I think I understood... if it finds the date return row and column of that cell, if not return row and column of last used cell of row 13.

Assuming this is correct, you can use the following:

Sub CopyTimeLine()

    Dim ws As Worksheet
    Dim ws7 As Worksheet
    Dim rng As Range
    Dim targetDate As Range
    Dim R, C As Integer

    'change sheet1 to suit
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    Set ws7 = ThisWorkbook.Worksheets("Sheet7")

    'change address of your cell with target date
    Set targetDate = ws2.Range("F13")

    'tries to find target date in first row
    Set rng = ws7.Range("13:13").Find(What:=targetDate.Value)

    If rng Is Nothing Then
        MsgBox "not Found"
        R = ws7.Cells(13, Columns.Count).End(xlToLeft).Row
        C = ws7.Cells(13, Columns.Count).End(xlToLeft).Column
    Else
        R = rng.Row
        C = rng.Column
    End If
  
    MsgBox "ROW: " & R & vbCrLf & "COLUMN: " & C

'Sheets("7").Select
  'Range(Cells(Y, x+1), Cells(Cells(14, 6) + 50, Cells(14, 6) + 59)).Select
  'Selection.Copy
  'Sheets("2").Select
  'Range("F14:G14").Select
  'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    'True, Transpose:=False
  
End Sub

R and C are now your Row and Column variables...

I hope this helps

 

[Bruno125sx]

Hello and thank you for the welcoming.

Thanks for you expertise. you definitely clean up my mess.

i'm almost there.

however, if the date is not found then i don't want to do anything just message box. (the date will be found anyway)
i need to find where (x,y) is the searched date so i can select and copy a group of cell just located from it below as such Cells(R, C+1), Cells(Cells(14, 6) + 50, Cells(14, 6) + 59)). then past it on my sheet2.

hope this make sens.

if i add this to you code, does it seems correct?:


Sub CopyTimeLine()

Dim ws As Worksheet
Dim ws7 As Worksheet
Dim rng As Range
Dim targetDate As Range
Dim R, C AsInteger

Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws7 = ThisWorkbook.Worksheets("Sheet7")

'change address of your cell with target date
Set targetDate = ws2.Range("F13")

'tries to find target date in first row
Set rng = ws7.Range("13:13").Find(What:=targetDate.Value)

If rng IsNothingThen
MsgBox "not Found"
'R = ws7.Cells(13, Columns.Count).End(xlToLeft).Row
'C = ws7.Cells(13, Columns.Count).End(xlToLeft).Column
Else
R = rng.Row
C = rng.Column
ws7.Range(ws.Cells(C, R + 1), ws7.Cells(ws.Cells(14, 6) + 50, ws7.Cells(14, 6) + 59)).Copy
ws2.Range("F14:G14").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False


End If

'MsgBox "ROW: " & R & vbCrLf & "COLUMN: " & C

 

[PCosta87]

Hi,

Yes, you can simply delete the R and C in the first part of the If condition if you don't need them.

About the rest, the correct statement is "Cells(Row, Column)" so I believe you may have that backwards, unless it is intentional .

 

[Bruno125sx]

thanks heaps.

but Dam i have this "subscript out of range error .

yellow on Set ws2 = ThisWorkbook.Worksheets("Sheet2").

do i miss somethings with active and thisworkbook statment.

any idear of reason?

Sub CopyTimeLine()

Dim ws2 As Worksheet
Dim ws7 As Worksheet
Dim rng As Range
Dim targetDate As Range
Dim R, C As Integer

Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws7 = ThisWorkbook.Worksheets("Sheet7")

'change address of your cell with target date
Set targetDate = ws2.Range("F13")

'tries to find target date in first row
Set rng = ws7.Range("13:13").Find(What:=targetDate.Value)

If rng Is Nothing Then
MsgBox "not Found"
'R = ws7.Cells(13, Columns.Count).End(xlToLeft).Row
'C = ws7.Cells(13, Columns.Count).End(xlToLeft).Column
Else
R = rng.Row
C = rng.Column
ws7.Range(ws7.Cells(R, C + 1), ws7.Cells(ws7.Cells(14, 6) + 50, ws7.Cells(14, 6) + 59)).Copy
ws2.Range("F14:G14").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False


End If

End Sub

 

[PCosta87]

thanks heaps.

but Dam i have this "subscript out of range error .

yellow on Set ws2 = ThisWorkbook.Worksheets("Sheet2").

do i miss somethings with active and thisworkbook statment.

any idear of reason?

Sub CopyTimeLine()

Dim ws2 As Worksheet
Dim ws7 As Worksheet
Dim rng As Range
Dim targetDate As Range
Dim R, C As Integer

Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws7 = ThisWorkbook.Worksheets("Sheet7")

'change address of your cell with target date
Set targetDate = ws2.Range("F13")

'tries to find target date in first row
Set rng = ws7.Range("13:13").Find(What:=targetDate.Value)

If rng Is Nothing Then
MsgBox "not Found"
'R = ws7.Cells(13, Columns.Count).End(xlToLeft).Row
'C = ws7.Cells(13, Columns.Count).End(xlToLeft).Column
Else
R = rng.Row
C = rng.Column
ws7.Range(ws7.Cells(R, C + 1), ws7.Cells(ws7.Cells(14, 6) + 50, ws7.Cells(14, 6) + 59)).Copy
ws2.Range("F14:G14").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False


End If

End Sub

Hi,

Double check if your sheet's name is "Sheet2". The best way to make sure it is exactly the same is to copy from tab and paste in the code.

Alternatively you can use the index number of the sheet instead of its name if you are planning on changing it in the future.

 

[Bruno125sx]

ok i will do ) thank you.
Great help

 

[PCosta87]

You are welcome