VB code needed as this is way beyond a novice like me!

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

in worksheet "adhoc" cell X9 is populated with formula =TODAY()
and cells X12:X25 are blank so that user can input data into them (in form
of text)

on execution I need some code that will carry out a serach of column 'N' in
"database" worksheet and paste the copied data ( X9, X12:X25 in "adhoc") into
the next available row of column 'N' ONLY if the date in cell ref X9 of
"adhoc" has not been found in column 'N' of "database"

On execution, if the data is found then only copy the data from cells
X12:X25 in "adhoc" that are not already present in cells O:AB of the
corresponding row that the date has been found.

eg

in "adhoc" worksheet:-

X9 = 10 October 2005
X12 = Mr Smith
X13= Mr Jones
X14= Mr Green
X15:X25 are blank

the search of column 'N' in "database" is carried out , and the date found
in X9 of "adhoc" has not been found. So X9, X12,X14 are copy/pasted into the
first available row in column 'N' of "database"

....however....

if the search of column 'N' in "database" does indeed find the date in X9 of
"adhoc" only the cells not alraedy there are pasted.

eg

in cell N22 of "database" 10 October 2005 is found
cell O22 holds the data "Mr Smith" and cells P22:AB22 are blank, so the data
back in cell X13 of "adhoc" (Mr Jones) needs to be added to cell P22 of
"database", cell X14 (Mr Green) needs to be added to Q22
....and so on....

Once this little trick has been performed, sheet "adhoc" is displayed and a
simple "done" msg displayed.

I hope I have explained that ok, and sorry for the waffle

realy apreciate a fix for this, as I said its total beyond me!
many thanks in advance
 
Sub ProcessAdHoc()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim res As Variant
Dim rng As Range, lastrow As Long
Set sh1 = Worksheets("adhoc")
Set sh2 = Worksheets("Database")
res = Application.Match(sh1.Range("X9").Value2, sh2.Columns(14), 0)
If IsError(res) Then
lastrow = sh2.Cells(Rows.Count, "N").End(xlUp).Row + 1
sh2.Cells(lastrow, "N").Value = sh1.Range("X9").Value
sh1.Range("X12:X25").Copy
sh2.Cells(lastrow, "O").PasteSpecial xlValue, Transpose:=True
Else
Set rng = sh2.Columns(14).Cells(res, 1)
For i = 12 To 25
If IsEmpty(rng.Offset(0, i - 11)) Then
rng.Offset(0, i - 11).Value = sh1.Cells(i, "X").Value
End If
Next
End If
End Sub


If database is empty, it starts adding data in row 2.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top