Duplicate date from cell above

[Guest]

I have a spreadsheet that once I have imported a range of data I need to have
the date duplicated from the cell above until there is a blank cell and then
repeat this process through a predefined number of rows. The info looks like
this after it is copied.

5/11 GBC 1PBT 8269 20 6542 10.8 N 10" 78 5/5 102"
Merfin Systems 1PBT 8280 41 10256 10.8 N 10" 78 5/20 103 1/2"
Wausau Paper 1PBT 8312 20 465860 11.0 N 10" 78 5/1 100 1/2"

5/12 Wausau Paper 1PBT 8312 101 465860 11.0 N 10" 78 5/1 100 1/2"

5/13 GBC 2PBT 8225 20 6443 9.1 N 10" 78 5/6 102"
Firstar 2PBT 8078 81 9974 9.0 N 10" 78 4/15 102"
The data maybe to wide for the screen. Each item is on one line.

 

[Tom Ogilvy]

What are the results you want:

5/11 GBC 1PBT 8269 20 6542 10.8 N 10" 78 5/5 102"
5/11 Merfin Systems 1PBT 8280 41 10256 10.8 N 10" 78 5/20 103 1/2"
5/11Wausau Paper 1PBT 8312 20 465860 11.0 N 10" 78 5/1 100 1/2"

5/12 Wausau Paper 1PBT 8312 101 465860 11.0 N 10" 78 5/1 100 1/2"

5/13 GBC 2PBT 8225 20 6443 9.1 N 10" 78 5/6 102"
5/13 Firstar 2PBT 8078 81 9974 9.0 N 10" 78 4/15 102"

If so, is all this text in column A or is it in multiple cells.

If in multiple cells, is the first GBC in B1, 5/11 in A1, and Merfin Systems
in A2?

 

[Guest]

In the Cell below 5/11 create a formula that references that cell. Something
like in cell A3 put =A2. Now Copy that formula. With your mouse Select the
entire range of data. Now Hit F5 -> Special Cells -> Blanks. Now only the
Blank cells in the data range will be selected. You can now paste the
formula. Copy the entire area and paste special vales and everything will be
filled in...

HTH

 

[Guest]

Each cell contains information beginning with "A1", which contains the date.
All the information is copied and paste special using VBA commands and then
sorted. The results should appear as you have them listed below. All this
needs to be done after being copied and pasted but prior to the sorting of
information as there is another set of info with an identical setup (columns
) that this info is compared to.
here is what it looks like prior to adding the date.
5/11 GBC 1PBT 8269 20 6542 10.8 N 10" 78 5/5 102"
Merfin Systems 1PBT 8280 41 10256 10.8 N 10" 78 5/20 103 1/2"
Wausau Paper 1PBT 8312 20 465860 11.0 N 10" 78 5/1 100 1/2"

5/12 Wausau Paper 1PBT 8312 101 465860 11.0 N 10" 78 5/1 100 1/2"

5/13 GBC 2PBT 8225 20 6443 9.1 N 10" 78 5/6 102"
Firstar 2PBT 8078 81 9974 9.0 N 10" 78 4/15 102"

This is what it needs to look like prior to sorting:
5/11 GBC 1PBT 8269 20 6542 10.8 N 10" 78 5/5 102"
5/11 Merfin Systems 1PBT 8280 41 10256 10.8 N 10" 78 5/20 103 1/2"
5/11 Wausau Paper 1PBT 8312 20 465860 11.0 N 10" 78 5/1 100 1/2"

5/12 Wausau Paper 1PBT 8312 101 465860 11.0 N 10" 78 5/1 100 1/2"

5/13 GBC 2PBT 8225 20 6443 9.1 N 10" 78 5/6 102"
5/13 Firstar 2PBT 8078 81 9974 9.0 N 10" 78 4/15 102"

 

[Tom Ogilvy]

Since you can't seem to answer the simple but essential questions asked,
then I guess you need to work with Jim.

 

[Guest]

Jim can you help me? Tom appently lacks social tack! Here is the complete
code.
Private Sub CommandButton1_Click()
'Copies information from #4 PM to current location
Workbooks.Open Filename:="M:\Customer Service\Sales Department\#4 PM.xls"
Sheets("PM# 4").Select
Dim varrange As Variant
On Error Resume Next
Set varrange = Application.InputBox("select a range of cells to
copy:", Type:=8)
If IsObject(varrange) = False Then Exit Sub
varrange.Select
Selection.Copy
Windows("Maury project.xls").Activate
Sheets("#4 PM Info").Select
ActiveSheet.Range("A4").PasteSpecial Paste:=xlValues
Workbooks("#4 PM.xls").Close

'Copies information from #1 PM to current location
Workbooks.Open Filename:="M:\Customer Service\Sales Department\#1 PM.xls"
Sheets("PM# 1").Select
On Error Resume Next
Set varrange = Application.InputBox("select a range of cells to
copy:", Type:=8)
If IsObject(varrange) = False Then Exit Sub
varrange.Select
Selection.Copy
Windows("Maury project.xls").Activate
Sheets("#4 PM Info").Select
ActiveSheet.Range("n4").PasteSpecial Paste:=xlValues
Workbooks("#1 PM.xls").Close

'THIS IS WERE I NEED IT TO ADD THE DATE based on
the date above it.


'Deletes colums from #4 PM info.
Columns("d:d").Select
Selection.EntireColumn.Delete
Columns("e:e").Select
Selection.EntireColumn.Delete
Columns("g:g").Select
Selection.EntireColumn.Delete
Columns("i:i").Select
Selection.EntireColumn.Delete
'Deletes colums from #1 PM info.
Columns("m:m").Select
Selection.EntireColumn.Delete
Columns("n:n").Select
Selection.EntireColumn.Delete
Columns("p").Select
Selection.EntireColumn.Delete

End Sub

 

[Guest]

Let me take a look at it... Tom is definitely one of the best coders I have
ever had the pleasuer to deal with and one day he will pull a rabbit out of
his hat that will answer a question of yours in ways few others ever could.

Back in a minute...

 

[Guest]

Here is a procedure you can use... It copies the date values in column A down
until it reaches the last cell in column B...

Public Sub CopyDates()
Dim lngLastRow As Long
Dim rngCurrent As Range
Dim wksCurrent As Worksheet
Dim dteToPaste As Date

Set wksCurrent = ActiveSheet
Set rngCurrent = wksCurrent.Range("A2")
lngLastRow = wksCurrent.Range("B65535").End(xlUp).Row

dteToPaste = rngCurrent.Value
Do While rngCurrent.Row <= lngLastRow
If rngCurrent.Value = Empty Then
If rngCurrent.Offset(0, 1).Value <> Empty Then _
rngCurrent.Value = dteToPaste
Else
dteToPaste = rngCurrent.Value
End If
Set rngCurrent = rngCurrent.Offset(1, 0)
Loop

End Sub

HTH

 

[Guest]

Jim your man! That worked great!!

Here is a procedure you can use... It copies the date values in column A down
until it reaches the last cell in column B...

Public Sub CopyDates()
Dim lngLastRow As Long
Dim rngCurrent As Range
Dim wksCurrent As Worksheet
Dim dteToPaste As Date

Set wksCurrent = ActiveSheet
Set rngCurrent = wksCurrent.Range("A2")
lngLastRow = wksCurrent.Range("B65535").End(xlUp).Row

dteToPaste = rngCurrent.Value
Do While rngCurrent.Row <= lngLastRow
If rngCurrent.Value = Empty Then
If rngCurrent.Offset(0, 1).Value <> Empty Then _
rngCurrent.Value = dteToPaste
Else
dteToPaste = rngCurrent.Value
End If
Set rngCurrent = rngCurrent.Offset(1, 0)
Loop

End Sub

HTH

 

[Tom Ogilvy]

Jim,
Even though Cliff is elated, you might want to change the first instance of
dteToPaste = rngCurrent.Value

to
dteToPaste = rngCurrent.Offset(-1,0).Value

Unless that first date is actually 01/00/1900

 

[Guest]

Fair enough... I was assuming a heading row. Should have mentioned that...
For that matter I could just set rngCurrent to wksCurrent.Range("A1") if
there was no header row. Either way all's well that ends well... Thanks Tom

 

[Tom Ogilvy]

Each cell contains information beginning with "A1", which contains the
date.

You could start with A1, but then you would process a row that doesn't need
to be processed. On the other hand, if you processed that row, you could
remove the first assignment of dteToPaste. So many choices.