VBA problem. Either really easy or well hard

Hile_Troy

New Member
Joined
Sep 27, 2011
Messages
15
This problem may be easier to solve than describe, I hope so... anyway:
I have data in 2 workbooks, call them book1.sheet1, and book2.sheet1. Book2 has very little data (at present only 4 rows, but this will be different each time the macro is run), book1 has roughly 780 rows. I need to:-
1/ Find each record in book1 that matches the first entry in column B in book 2 and where column B in book1 = "NEW".
2/ For each record found above, copy the contents of the first entry in column C book2 to column B in the same row as the record found above.
3/ Do both of the above for each row in book2.

I have read 3 days worth of guides, posts etc. and been unable to find anything that even gets me close. I am not good enough in vba to write my own code, but have become quite adept at reading and adapting code.

Any help on this would be massively appreciated.
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Hile_Troy

New Member
Joined
Sep 27, 2011
Messages
15
Hmm... I'm beginning to suspect this is as difficult as I thought it was going to be...
 

Hermanito

Well-known Member
Joined
Apr 4, 2007
Messages
1,238
Doesn't seem to be too hard imho...
Don't have time right now, but if someone else hasn't jumped in before tonight, I will give it a go...

Topics move very fast in this forum, it happens that some are overlooked, doesn't mean they are too difficult :)
 

Jameo

Active Member
Joined
Apr 14, 2011
Messages
270
It is difficult to write the code without examples of your spreadsheets, as such this is untested

Code:
Public Sub test()
 
Dim Wb1 As Workbook, Wb2 As Workbook
Dim sht As Worksheet
Set Wb1 = Workbooks("Book1")
Set Wb1 = Workbooks("Book2")
Set sht = Worksheets("Sheet1")

LRow1 = Wb1.sht.Range("A" & Rows.Count).End(xlUp).Row
LRow2 = Wb1.sht.Range("A" & Rows.Count).End(xlUp).Row

With Wb1
    For i = 1 To LRow1
    
        If Wb1.sht.Cells(i, 2).Value = "New" Then
            If Wb1.sht.Cells(i, 1).Value = Wb2.sht.Cells(1, 2).Value Then
                Wb2.sht.Cells(1, 3).Copy Destination:=Wb1.sht.Cells(i, 2)
            End If
        End If
    
    
    
    
    Next i
End With

End Sub

The workbooks must be named book1 and and book2, and the sheets sheet1.

If you have issues, upload your workbooks and I will have a further look
 

Hile_Troy

New Member
Joined
Sep 27, 2011
Messages
15
Hi jameo

Many thanks for your code, it I was most of the way through having a go at writing it myself when I got your message, but it did inspire me on how to finish it and make it work. The code I am using is below, it has an extra If section because the row in book1 changes part of the way down the sheet. (Had a minor panic until I noticed this)

Sub ModuleNumbersToCurriculum()
Dim sRow As Long
Dim dRow As Long
Dim sSheet As Worksheet
Dim dSheet As Worksheet
Set sSheet = Workbooks("DifferenceReport.xls").Sheets("New Modules Report")
Set dSheet = Workbooks("compareCurriculumnew.xls").Sheets("Curriculum Overview")
sRow = 1
dRow = 9
Do Until sSheet.Cells(sRow, "D") = ""
Do Until dSheet.Cells(dRow, "N") = "stop"
If dSheet.Cells(dRow, "B") = "NEW" Then
If dSheet.Cells(dRow, "N") = sSheet.Cells(sRow, "D") Then
sSheet.Cells(sRow, "C").Copy Destination:=dSheet.Cells(dRow, "C")
End If
If dSheet.Cells(dRow, "P") = sSheet.Cells(sRow, "D") Then
sSheet.Cells(sRow, "C").Copy Destination:=dSheet.Cells(dRow, "C")
End If
End If
dRow = dRow + 1
Loop
sRow = sRow + 1
dRow = 9
Loop
End Sub


Anyway, thanks again.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,877
Messages
5,574,774
Members
412,617
Latest member
mlharris
Top