Extract name, dates & number as criteria Then paste to current file

  • Thread starter Thread starter Ricky Pang
  • Start date Start date
R

Ricky Pang

Hello Experts,
Could you help with this question. How do you write out the following
command within code? (This code will be embedded in the current
worksheet)

1) Open C:\Extract names.xls
2) Copy A1 (Name, ie. Joe), B1 (Beginning Date ie. Dec.1,2003), C1
(Ending Date, ie. Dec.5,2003), D1 (Number, ie. 105).
3) In the current worksheet, use the (Number) to match row A's header.
In this example, the (Number) of 105 is located in F1.
4) Once in column [F], go down to the corresponding beginning date and
paste {Name}s throughout the entire range including the ending date. In
this example, the beginning date of Dec.1,2003 is in cell [A10] and
ending date of Dec.5,2003 is in cell [A14]. So there should be Joe in
every cell from [A10] to [A14] inclusive.
5) When pasting the names, keep all of the current worksheet's existing
formats such as cell color backgrounds. Paste only the name.
6) Now within the (Names), go down to second cell and color fill cell
background as Yellow. Should be yellow in cell [A11].
7) Now from A11, count every 3rd cell and color fill background as
Green. Should be cell [A15].
8) Go to last cell within the {Name} range. In this example, it will be
cell [A15] again. Color fill background as Red, no matter what color
was there before.
9) Delete C:\Extract names.xls

Your help is greatly appreciate.

Thanks in advance,
Ricky
 
Hi Ricky,

The best way to get started with a problem like this is to turn on the
macro recorder (Tools/Macro/Record New Macro from the Excel menu) and then
perform the steps below manually. This will create a skeleton of the code
required to do what you want to do. It won't be very well written or
flexible, but it's great to get you started. Once you have this skeleton
code recorded you can start cleaning it up and making it more general. Post
back with specific questions related to this process.

--
Rob Bovey, MCSE, MCSD, Excel MVP
Application Professionals
http://www.appspro.com/

* Please post all replies to this newsgroup *
* I delete all unsolicited e-mail responses *
 
Rob,
My specific question how do you lookup the number to match according to
the copied (Name) cell? And, how do you count the cell, ie. go to the
2nd cell within the pasted range? And, how do you count down the column
and go to every 3rd cell? And finally, how do you go right to the last
cell within the pasted within? So basically, points #4 through #8. The
macro recorder doesn't record these steps. That's where I need help with
writing the codes.

Thanks again,
Ricky
 
Hi Ricky,

Can you post the macro recorded code? Although it's not perfect, it does
give a much clearer indication of what you want to do. I know it's clear to
you, but it's much easier for someone like me, who's looking in from the
outside, to help you if you have something to start with rather than trying
to write an entire subroutine based on a verbal description. That's the
point I was getting at.

--
Rob Bovey, MCSE, MCSD, Excel MVP
Application Professionals
http://www.appspro.com/

* Please post all replies to this newsgroup *
* I delete all unsolicited e-mail responses *
 
Hi Rob,
Thanks for your response. Here's my macro, albeit rough as it is, I
wasn't not able to do a (Number) lookup; thus, I had to manually goto
the proper cell ranges to paste my (Names).

Workbooks.Open Filename:= _
"C:\Extract Names.xls
Range("A1").Select
'A1 is just the Names. I should have also copied A2 beginning date, A3
ending date, A4 Number, but here's where I to specify what each of these
cells represent ie. perhaps dim A1 as ....
Selection.Copy
Windows("Current Worksheet.xls").Activate
'Instead of manually goto this range, here's where a lookup function to
search the copied A4 Number to match current worksheet's Row A header.
'Also need to match the beginning and ending dates listed on current
worksheet's column A
Range("F10:F14").Select
'before pasting the Names, check if there are data that's already there.
Popup warning and ask "Do you want to overwrite?". If yes, continue
with next line. If not, then end macro here.
'the Names are now pasted
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Need to goto 2nd cell and color as yellow
Range("F11").Select
Selection.Interior.ColorIndex = 6
'Then, goto every 3rd cell and color as green
Range("F14").Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
'Goto the last cell and color as red
Selection.Interior.ColorIndex = 3
End


I've been searching throughout the newsgroups for something similar but
of no avail. Hopefully you could offer some guidance.

Thanks again,
Ricky
 
Hi Ricky,

This is a pretty complex macro you're asking for. I've done my best to
write one that does what you want. It works here on some dummy data I've
created, but I'm sure you'll need to alter it to suit your needs. I'm off on
vacation very shortly, so I apologize if I'm not here to answer follow-up
questions for a few days. Maybe someone else can jump in and help you out in
my absence.

Sub Demo()

Dim dteStart As Date
Dim dteEnd As Date
Dim lNumber As Long
Dim szName As String
Dim szBookName As String
Dim lColumn As Long
Dim lRowStart As Long
Dim lRowEnd As Long
Dim lIndex As Long
Dim rngCell As Range
Dim rngLookup As Range
Dim rngDest As Range
Dim rngTemp As Range
Dim wksDest As Worksheet
Dim wkbSource As Workbook

''' Open the source workbook and get the data.
Set wkbSource = Workbooks.Open("E:\Extract Names.xls")
With wkbSource.Worksheets(1)
szName = .Range("A1").Value
dteStart = .Range("A2").Value
dteEnd = .Range("A3").Value
lNumber = .Range("A4").Value
End With

''' Close and delete the source workbook.
szBookName = wkbSource.FullName
wkbSource.Close False
Kill szBookName

''' Substitute your worksheet name here.
Set wksDest = ThisWorkbook.Worksheets("Sheet1")

''' Find the column with "Number" in row 1.
Set rngLookup = wksDest.UsedRange.Resize(1)
lColumn = Application.Match(lNumber, rngLookup, False)

''' Find the rows with the start and end dates in column A.
''' We can't use Application.Match here because it is not
''' reliable with date values.
Set rngLookup = wksDest.UsedRange.Resize(, 1)
For Each rngCell In rngLookup
If DateDiff("d", rngCell.Value, dteStart) = 0 Then _
lRowStart = rngCell.Row
If DateDiff("d", rngCell.Value, dteEnd) = 0 Then _
lRowEnd = rngCell.Row
Next rngCell

''' Construct the destination range
Set rngDest = wksDest.Cells(lRowStart, _
lColumn).Resize(lRowEnd - lRowStart + 1)

''' If there is already data in the range, warn the user.
If Application.CountA(rngDest) > 0 Then
If MsgBox("Data exists, continue?", _
vbYesNo) = vbNo Then Exit Sub
End If

''' Add the name to the destination range
rngDest.Value = szName

''' Color the destination range.
rngDest.Interior.ColorIndex = xlNone
rngDest.Cells(2, 1).Interior.ColorIndex = 6
Set rngTemp = wksDest.Range(rngDest.Cells(3, 1), _
rngDest.Cells(rngDest.Rows.Count, 1))
lIndex = 1
For Each rngCell In rngTemp
If lIndex Mod 3 = 0 Then rngCell.Interior.ColorIndex = 4
lIndex = lIndex + 1
Next rngCell
rngDest.Cells(rngDest.Rows.Count, 1).Interior.ColorIndex = 3

End Sub

--
Rob Bovey, MCSE, MCSD, Excel MVP
Application Professionals
http://www.appspro.com/

* Please post all replies to this newsgroup *
* I delete all unsolicited e-mail responses *
 
Thank-you so much Rob.
Your solution is greatly appreciated. The code is out of my league but
I am definitely learning from you and other experts. I will test this
code as soon as I get home. And, I will keep you posted with the
results. In the meantime, have a wonderful vacation!

Thanks again for your prompt reply.
Ricky
 
Hi Rob (and other Experts),
About halfway through the macro, I got a "Run Time Error '13': Type
mismatch". It highlighted the error of:
If DateDiff("d", rngCell.Value, dteStart) = 0 Then _
lRowStart = rngCell.Row
What is your suggestion to troubleshoot this error? What does the "d"
represent? (Within VB Editor help, the "d" just says Interval as
String)


I copied a bigger portion of ease of reference:

''' Find the rows with the start and end dates in column A.
''' We can't use Application.Match here because it is not
''' reliable with date values.
Set rngLookup = wksDest.UsedRange.Resize(, 1)
For Each rngCell In rngLookup
If DateDiff("d", rngCell.Value, dteStart) = 0 Then _
lRowStart = rngCell.Row
If DateDiff("d", rngCell.Value, dteEnd) = 0 Then _
lRowEnd = rngCell.Row


Thanks again,
Ricky
 
Hi Ricky,

Against my wife's explicit instructions, I am still sneaking to the
computer to check for follow-up questions to my responses. I must be quick
or she will discover my activities and may even beat me for it. <g>

When you specified your initial conditions, you said that dates would be
located in column A of the worksheet into which the data was being loaded.
The error you are reporting suggests that there are entries in column A that
are not dates. This would cause a type mismatch error in the section of code
that attempts to locate the start and end dates.

Substitute the following code for the existing section in question.
Notice how it checks whether a cell contains a Date value before it tries to
compare the value to the starting and ending dates pulled from the source
data workbook:

''' Find the rows with the start and end dates in column A.
''' We can't use Application.Match here because it is not
''' reliable with date values.
Set rngLookup = wksDest.UsedRange.Resize(, 1)
For Each rngCell In rngLookup
If IsDate(rngCell.Value) Then
If DateDiff("d", rngCell.Value, dteStart) = 0 Then _
lRowStart = rngCell.Row
If DateDiff("d", rngCell.Value, dteEnd) = 0 Then _
lRowEnd = rngCell.Row
End If
Next rngCell

Note that both the beginning and ending dates pulled from the source
data workbook MUST exist in column A of the destination worksheet or the
macro will fail, and this will be a much more difficult problem to
reconcile.

--
Rob Bovey, MCSE, MCSD, Excel MVP
Application Professionals
http://www.appspro.com/

* Please post all replies to this newsgroup *
* I delete all unsolicited e-mail responses *
 
Hi Rob,
Please let me extend my gratitude to you for helping me even while
you're on vacation. You've been graciously considerate. Your code
works like a charm! Just amazing!! With your explanation of the run
time error, I figured that it was the title called Date in cell A1. So
the entire column A wasn't really all dates because of that text title
cell. Thanks to your adjustment, it works now and it's a thing of
beauty.

I hope the Mrs. won't be mad me for asking this.(j/k) She is a very
important person indeed.
Towards the end of the macro, how do I change the following line so that
the paste feature, pastes only as values? This is to maintain the color
fill background that was originally there (before the macro was run).
An excerpt of that code:

''' Add the name to the destination range
rngDest.Value = szName

Perhaps other experts might lend a hand while Rob enjoys his time away.
I will continue to work on other areas of my spreadsheet towards
completion. I may have more questions in the future. In the meantime,
I'd like to say thanks again Rob.
Have a great holiday!

Ricky
 
Hi Ricky,

The macro already places only the values in the cells (using the line of
code you reference below). The reason the formatting is being removed is
that I was under the mistaken assumption that the format of the destination
area should be reset prior to adding the new shading. If you delete the
following line of code from further down:

rngDest.Interior.ColorIndex = xlNone

The original format of the destination cells will not be affected.

--
Rob Bovey, MCSE, MCSD, Excel MVP
Application Professionals
http://www.appspro.com/

* Please post all replies to this newsgroup *
* I delete all unsolicited e-mail responses *
 
Back
Top