Macro to take cell value, search another sheet, and paste in correct location

Try this...if i got what you want correctly :)

Sub copysearchcell()
Dim mys1, mys2 As Worksheet
Dim Msg, Style, Title, Help, Ctxt, Response, MyString As String
Msg = "Ovewrite?"                                   ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2     ' Define buttons.
Title = "Value found"                               ' Define title.
Dim lookFor As Range
Dim rng As Range
Dim col As Integer
Dim found As Variant
 
Set mys1 = Application.ActiveWorkbook.Worksheets("Month")
Set mys2 = Application.ActiveWorkbook.Worksheets("Year")
mys1.Activate
X = mys1.Range("G2").Value
mys2.Activate
Set lookFor = mys1.Range("G2")
Set rng = mys2.Columns("A:C")
col = 1
found = Application.VLookup(lookFor.Value, rng, col, 0)
If IsError(found) Then
    Y = mys2.UsedRange.Rows.count       ' month doesnt exist
    Z = mys2.UsedRange.Columns.count
    mycell = "A" & Z
    mys2.Range(mycell).Value = X
    mys2.UsedRange.Sort Key1:=mys2.Columns("A"), Order1:=xlAscending
Else
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbYes Then            ' User chose Yes.
        mys2.Range("D2").Value = X      ' yes = pastes cells A2 to D2 (Month) into relevant B2-E2 (Year).
    Else                                ' User chose No.
        Exit Sub                        ' Do nothing
    End If
End If
End Sub

Select allOpen in new window

Few gliches, but Ive noticed a few problems my end, the cell being copied is txt and cant be sorted in date order in worksheet year.  Might have to have another cell (H2) thats in month form eg 01/09/09 so we can use the month sention so map to the month column (A) in year.  

Also at the moment it doesnt paste the cells A2-D2 into Worksheet year at all.

Please explain a bit more...do you mean A2:D2 from month to A2:D2 year?

What I need is cells A2-D2 copied from worksheet Month to worksheet Year.

Column A in worksheet year will be a list of months from say Jan 2009 onwards.  I want to check to see if an entry for the month in worksheet month is already made in year and if so paste A2-D2 into cells B2-E2, and if the month doesnt exist in the list to creat a row for it.

OK, i think i understand...hold on a minute

Sub copysearchcell2()
Dim mys1, mys2 As Worksheet
Dim Msg, Style, Title, Help, Ctxt, Response, MyString As String
Msg = "Ovewrite?"                                   ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2     ' Define buttons.
Title = "Value found"                               ' Define title.
Dim lookfor As Range
Dim lookfor2, myrng As String
Dim rng, rng1 As Range
Dim col, rwc, cocl As Integer
Dim found As Variant

Set mys1 = Application.ActiveWorkbook.Worksheets("Month")
Set mys2 = Application.ActiveWorkbook.Worksheets("Year")
mys1.Activate
X = mys1.Range("G2").Value
x1 = mys1.Range("A2").Value
x2 = mys1.Range("B2").Value
x3 = mys1.Range("C2").Value
x4 = mys1.Range("D2").Value
mys2.Activate
Set lookfor = mys1.Range("G2")
lookfor2 = mys1.Range("G2").Value
Set rng = mys2.Columns("A:C")
'mys2.UsedRange.Select
myrng = mys2.UsedRange.Address
Set rng1 = mys2.Range(myrng)
col = 1
found = Application.VLookup(lookfor.Value, rng, col, 0)
If IsError(found) Then
    Y = mys2.UsedRange.Rows.count       ' month doesnt exist
    Z = mys2.UsedRange.Columns.count
    mycell = "A" & (Z - 1)
    mys2.Range(mycell).Value = X
    mys2.UsedRange.Sort Key1:=mys2.Columns("A"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=5, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    Else
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbYes Then            ' User chose Yes.
        mys2.Range("B2").Value = x1      ' yes = pastes cells A2 to D2 (Month) into relevant B2-E2 (Year).
        mys2.Range("C2").Value = x2
        mys2.Range("D2").Value = x3
        mys2.Range("E2").Value = x4
    Else                                ' User chose No.
        Exit Sub                        ' Do nothing
    End If
End If
End Sub

For some reason this doesnt copy the data for me, attached is a copy of a macro Brettdj wrote for another project a few weeks ago.

Basically it does what I need, but it copies each cell and places all data in the adjacent cell next to the date (all concat into 1 cell).  I need each entry eg A2, B2, C2 etc to go in corresponding cells in that row for that month eg B2, C2, D2 etc

Dandraka, I really cant see why your code doesnt work for me, maybe the cell if formatted differently on my sheet, what version of excel you using?

ps, we can forget the msgbox check as not essiential.

Thanks

Andrew

Sub SetScheduleTest4()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Dim c As Range
    Dim MyDic As Object
    Set MyDic = CreateObject("scripting.dictionary")
    Set ws1 = Sheets("Release Master")
    Set ws2 = Sheets("Change Master")
    Set ws3 = Sheets("Calendar")
    ws3.Cells.Clear
    ws3.Columns(1).NumberFormat = "d-mmm-yy"
    Set rng1 = ws1.Range(ws1.[k2], ws1.Cells(Rows.Count, "k").End(xlUp))
 
    For Each c In rng1
        If MyDic.exists(c.Value) = False Then
            ws3.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = c
            ws3.Cells(Rows.Count, "A").End(xlUp).Offset(0, 1) = "PM - " & ws1.Cells(c.Row, "H") & ", " & ws1.Cells(c.Row, "B") & ", " & ws1.Cells(c.Row, "C") & ", " & ws1.Cells(c.Row, "D") & ", " & ws1.Cells(c.Row, "E") & ", " & ws1.Cells(c.Row, "G") & ws1.Cells(c.Row, "P") & Chr(10)
            MyDic.Add c.Value, 1
        Else
            Set rng2 = ws3.Columns("A").Find(c.Value)
            rng2.Offset(0, 1) = rng2.Offset(0, 1) & "PM - " & ws1.Cells(c.Row, "H") & ", " & ws1.Cells(c.Row, "B") & ", " & ws1.Cells(c.Row, "C") & ", " & ws1.Cells(c.Row, "D") & ", " & ws1.Cells(c.Row, "E") & ", " & ws1.Cells(c.Row, "G") & ", " & ws1.Cells(c.Row, "P") & Chr(10)
        End If
    Next c
    Set rng2 = ws2.Range(ws2.[g2], ws2.Cells(Rows.Count, "g").End(xlUp))
    
    For Each c In rng2
        If MyDic.exists(c.Value) = False Then
            ws3.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = c
            ws3.Cells(Rows.Count, "A").End(xlUp).Offset(0, 2) = ws2.Cells(c.Row, "B") & ", " & ws2.Cells(c.Row, "C") & ", " & ws2.Cells(c.Row, "R") & ", " & ws2.Cells(c.Row, "J") & Chr(10) & Chr(10)
            MyDic.Add c.Value, 1
       
        Else
            Set rng2 = ws3.Columns("A").Find(c.Value)
            rng2.Offset(0, 2) = rng2.Offset(0, 2) & ws2.Cells(c.Row, "B") & ", " & ws2.Cells(c.Row, "C") & ", " & ws2.Cells(c.Row, "R") & ", " & ws2.Cells(c.Row, "J") & Chr(10) & Chr(10)
        End If
    Next c
    
    
   With ws3
        .Columns(1).NumberFormat = "d-mmm-yy"
        .UsedRange.Sort Key1:=Range("A2"), Order1:=xlAscending
        .UsedRange.Borders.LineStyle = xlContinuous
        .UsedRange.Borders.Weight = xlThin
        .UsedRange.Borders.ColorIndex = xlAutomatic
    End With
 
    End If
 
 
End Sub

Select allOpen in new window

Can you just do a one off fill in column A of Year sheet to populate all the months you think you will need, or all months for some time into the future.

You can easily populate the column with sequential months:

Put a date in A2 eg 01/09/2009
In A3 put formula =EOMONTH(A2,1)
In B3 put formula =TEXT(A3,"mmmm yyyy")

Copy these down columns A & B as far as you want to go, five years is only going to be 60 rows so its not going to make the file massive if you go a long time into the future.

Then copy column B and paste special values into column A. Column B can then be deleted and you have column A filled with the text month values in order.

The routine required would then only have to do a find and paste alongside, rather than having to insert in the right place if not found.

Cheers
Rob H

rob, that isnt a bad idea mate, Im only doing the figures once a month so a copy and past will only take seconds, prob is there will be a chart linked to this, but I guess it might be easier to just add the figures as I go than do it automatically.

Just would have been nice ;)

If theres going to be a chart on the year sheet, I assume the x axis will be the date.

Would it not be better for the 'date' values to be evenly distributed along the axis, as it would be a timeline. The text values won't be recognised as dates when creating the graph so won't be able to format automatically as a timeline but you will be able to set the axis to only show months at spaced intervals, eg evry fourth month title, looks like quarterly.

If the dates were true date values, the graph could handle it as a timeline but I guess the output is giving a text date.

With the text, the find value and add alongside would be simple enough to automate, including a check for whether a value already exists.

I will work on a code for doing the find.

Cheers
Rob H

Code looks good Rob, prob is when I run the macro it always goes straight to the error sub, I have defined name for "FindDate" to G2 (which is formatted to a date format) and I have defined "Dates"  for Column A of sheet year (also formatted as date).

Am I missing something?

Put an apostrophe in front of the On Error line so that the routine doesn't have this line. The error should then actually happen and the debug should show you where the rror is.

If you have populated the year sheet with a big range of dates as suggested previously, you probably won't need the error routine anyway as the date should be there.

Cheers
Rob H

The error is coming up at this point, "object variable or with variable not set.


    Selection.Find(What:=FindDate, After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate

A couple of options:

1) The variable FindDate has not been defined correctly. Check Range Name defined.
2) Syntax in older version of excel.

Which version of excel are you using? The syntax for the search function may have changed in xl07 where I recorded this statement.

Start a macro Recording and do the edit find routine with a known value. Stop recording and look at the script created. The script will have the value you searched for in double quotes, this will need replacing with the FindDate variable.

It could also be where I changed it manually after I had recorded it but it still worked here. Where it has "Lookin:= _ xlValues" the original had xlFormulas. You could try changing that back, particularly if your dates are still formulas.

Cheers
Rob H

Cheers Rob

It was cells.Find, not selection.find.  Its all good.

Thanks

Andrew

Cells.Find(What:=FindDate, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

Select allOpen in new window