On Enter: next row copying certain fields from previous row

L

Lava

I am in a situation where we're using an Excel sheet to massively inpu
a lot of data into a database. The Excel sheet with its data is bein
imported into the database. Anyway, the problem focuses on th
efficiency of the Excel sheet...

To illustrate a clear example:
COLUMN_A : Artists
COLUMN_B : Albums
COLUMN_C : Songs

For certain reasons it's necessary to have the input like that: for a
artist albums are enlisted and for each album the songs. It means tha
with the entry of each new song for an already specified Artist an
Album I have to repeat the artist and the album.

This can be done by means of dragging the value with the mouse an
filling all fields in the column that are the same. But it has to b
more efficient.... automatically. That's a big demand right now fro
some datatypist who want to focus on entering as much as possible i
little time. For us, we don't work with Artists, Albums and Songs..
but it gives you an idea of what it's about :)

What I'd like is to specify an Artist with an Album and start with th
first song. I press [enter] and the focus is on the Song field in th
next row. I'd like to create a Macro and event catcher so that wit
each [enter] (entering the next row) the values of the fields fo
COLUMN_A and COLUMN_B are copied from the previous row. If it's a ne
album or artist at some point... a user can change it and from tha
point on that album or/and artist will be used as previous value.

Problem. I'm not at all experienced in Excel programming. I guess tha
this may be quite a simple trick or macro to get it to work, but for m
it's a big problem. Tried some things, but ended up with nothing tha
worked even remotely.

I couldn't find some good tutorial on getting this issue solved. It'
not my wish to learn Excel extensively. It just happens that out of th
blue we end up with one very wished for feature of the Excel shee
(template) which is used a lot.

Anybody got some tips on the Macro itself... and secondly how to get i
to execute automatically on entering a new COLUMN_C field in the nex
row (trigger)?

Thanks BIG time if someone can help :
 
J

Jim Cone

Lava,
Maybe...
Enter only the song title and add the artist and album each time
they change. Then use John Walkenbach's tip here...
http://www.j-walk.com/ss/excel/usertips/tip040.htm
to fill in the blank cells after the data entry is complete.

Jim Cone
San Francisco, USA


"Lava"
<[email protected]>
wrote in message

I am in a situation where we're using an Excel sheet to massively input
a lot of data into a database. The Excel sheet with its data is being
imported into the database. Anyway, the problem focuses on the
efficiency of the Excel sheet...
To illustrate a clear example:
COLUMN_A : Artists
COLUMN_B : Albums
COLUMN_C : Songs
For certain reasons it's necessary to have the input like that: for an
artist albums are enlisted and for each album the songs. It means that
with the entry of each new song for an already specified Artist and
Album I have to repeat the artist and the album.

This can be done by means of dragging the value with the mouse and
filling all fields in the column that are the same. But it has to be
more efficient.... automatically. That's a big demand right now from
some datatypist who want to focus on entering as much as possible in
little time. For us, we don't work with Artists, Albums and Songs...
but it gives you an idea of what it's about :)

What I'd like is to specify an Artist with an Album and start with the
first song. I press [enter] and the focus is on the Song field in the
next row. I'd like to create a Macro and event catcher so that with
each [enter] (entering the next row) the values of the fields for
COLUMN_A and COLUMN_B are copied from the previous row. If it's a new
album or artist at some point... a user can change it and from that
point on that album or/and artist will be used as previous value.

Problem. I'm not at all experienced in Excel programming. I guess that
this may be quite a simple trick or macro to get it to work, but for me
it's a big problem. Tried some things, but ended up with nothing that
worked even remotely.

I couldn't find some good tutorial on getting this issue solved. It's
not my wish to learn Excel extensively. It just happens that out of the
blue we end up with one very wished for feature of the Excel sheet
(template) which is used a lot.
Anybody got some tips on the Macro itself... and secondly how to get it
to execute automatically on entering a new COLUMN_C field in the next
row (trigger)?
Thanks BIG time if someone can help :)--
Lava
 
L

Lava

Hmmz, I see... so instead of an immediate fill, the filling of the empty
fields is done in one go at the end of the data entry. Still it involves
quite a few clicks and selections and such. Would it be possible to
achieve something like this by means of a Macro and perhaps a button
(or shortcut) otherwise?

I haven't given up hope yet on the immediate fill, but a Macro and
button (shortcut) involving _nothing_ more, but a simple click at the
end of the entry would suffice as well.
 
J

Jim Cone

Lava,

You can experiment with the following code, which should be
placed in the sheet module of the data entry sheet.
It assumes the data entry is in Column C.
Jim Cone
San Francisco, USA

"---------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo BadFill
Application.EnableEvents = False
Dim rngToFill As Excel.Range
If Not Application.Intersect(Target(1), Columns("C")) Is Nothing Then
Set rngToFill = Range(Target(1, -1).Address, Target(1, 0).Address)
If Application.CountA(rngToFill) = 0 Then _
rngToFill.Value = rngToFill.Offset(-1, 0).Value
Target(2, 1).Activate
Set rngToFill = Nothing
End If
BadFill:
Application.EnableEvents = True
End Sub
'----------------------------


"Lava"
<[email protected]>
wrote in message

Hmmz, I see... so instead of an immediate fill, the filling of the empty
fields is done in one go at the end of the data entry. Still it involves
quite a few clicks and selections and such. Would it be possible to
achieve something like this by means of a Macro and perhaps a button
(or shortcut) otherwise?

I haven't given up hope yet on the immediate fill, but a Macro and
button (shortcut) involving _nothing_ more, but a simple click at the
end of the entry would suffice as well.--
Lava
 
L

Lava

Okay, small update...

I've decided to use a piece of code by Dave Peterson. It can be found
in the attached zipfile, in an example Excel file. The subroutine is
named FillColumnBlanks(). It's a routine attached to a button and
executed at the end of all input.

I chose for this alternative for the time being because of the one-time
execution. If a macro is executed each time a line is finished it might
delay things and cause problems when the person working with it is
doing some massive and quick input typing blind from a papersheet.
Triggering per entry is something I do keep in mind for testing.

Problem with it is defining the range. When you open the Excel file
you'll find a column named "Gebouw" on the left. I've basically defined
8 lines, but the value in "Gebouw" and "Ruimte" can be repeated until a
new value is being defined. By means of the button "Vul lege velden"
(fill empty fields) it should fill things till line 8. HOWEVER... it
fills it till line 42 or something.

It would appear that Excel keeps a wrong Last Row in mind. Maybe I once
had a value in line 42 and deleted it? How can I let Excel find the REAL
last row which is line 8 in this case?

P.S. the buttons are on top (above "Gebouw" and "Ruimte")


+-------------------------------------------------------------------+
|Filename: Import Shouwing.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3907 |
+-------------------------------------------------------------------+
 
L

Lava

Funny thing... I got it working perfectly for the first column, but it
fails to work with the second column? No idea why? I clearly selected B
(column Ruimte) instead of A (column Gebouw) and repeated all steps and
changed things accordingly in the code. :confused:


Code:
--------------------
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim colGebouw, colRuimte As Long

Set wks = Worksheets("Data Schouwing")

With wks
colGebouw = .Range("a2").Column

LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error Resume Next
Set rng = .Range(.Cells(2, colGebouw), .Cells(LastRow, colGebouw)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, colGebouw).EntireColumn
.Value = .Value
End With

Set rng = Nothing
End With

With wks
colRuimte = .Range("b2").Column

LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error Resume Next
Set rng = .Range(.Cells(2, colRuimte), .Cells(LastRow, colRuimte)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, colRuimte).EntireColumn
.Value = .Value
End With

Set rng = Nothing
End With
End Sub
 
L

Lava

Funny thing... I got it working perfectly for the first column, but i
fails to work with the second column? No idea why? I clearly selected
(column Ruimte) instead of A (column Gebouw) and repeated all steps an
changed things accordingly in the code. :confused:


Code
-------------------
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim colGebouw, colRuimte As Long

Set wks = Worksheets("Data Schouwing")

With wks
colGebouw = .Range("a2").Column

LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error Resume Next
Set rng = .Range(.Cells(2, colGebouw), .Cells(LastRow, colGebouw)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, colGebouw).EntireColumn
.Value = .Value
End With

Set rng = Nothing
End With

With wks
colRuimte = .Range("b2").Column

LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error Resume Next
Set rng = .Range(.Cells(2, colRuimte), .Cells(LastRow, colRuimte)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, colRuimte).EntireColumn
.Value = .Value
End With

Set rng = Nothing
End With
End Su
 
L

Lava

Anybody got an idea how to get the code one post earlier to work for
both the first and the second column (or/and any other column)? When I
change A2 into B2 it won't work with the second column either. It
limits itself to the first one.

So far I was able with some help to come up with a solution to a
problem, but this time I'm stuck. Can someone try the code above and
tell me what code parts need to be added/changed to make it work for
column A and B together?
 
D

Dave Peterson

Maybe something like this:

Select a cell in each of the columns you want to fix.

Option Explicit
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim myRng As Range
Dim myCell As Range
Dim myCol As Long

Set wks = Worksheets("Data Schouwing")

With wks
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

Set myRng = Intersect(Selection.EntireColumn, .Rows(1))

For Each myCell In myRng.Cells
myCol = myCell.Column

Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, myCol), .Cells(LastRow, myCol)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
'no more msgbox and don't exit sub
'MsgBox "No blanks found"
'Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, myCol).EntireColumn
.Value = .Value
End With

Next myCell
End With
End Sub
Funny thing... I got it working perfectly for the first column, but it
fails to work with the second column? No idea why? I clearly selected B
(column Ruimte) instead of A (column Gebouw) and repeated all steps and
changed things accordingly in the code. :confused:

Code:
--------------------
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim colGebouw, colRuimte As Long

Set wks = Worksheets("Data Schouwing")

With wks
colGebouw = .Range("a2").Column

LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error Resume Next
Set rng = .Range(.Cells(2, colGebouw), .Cells(LastRow, colGebouw)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, colGebouw).EntireColumn
.Value = .Value
End With

Set rng = Nothing
End With

With wks
colRuimte = .Range("b2").Column

LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

On Error Resume Next
Set rng = .Range(.Cells(2, colRuimte), .Cells(LastRow, colRuimte)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, colRuimte).EntireColumn
.Value = .Value
End With

Set rng = Nothing
End With
End Sub
 
L

Lava

It gives no indication of any line. I made your alterations to the code
I got and tried it, but all I got was a little popup stating that
error. It didn't even switch to the VB editor like it did other times,
but it remained in the Excel sheet. I will attach the sheet within 30
minutes... maybe that'll clear things up as there's an applied example.
P.S. I'm not familiar with VB debugging... so if I overlooked a simple
way to find the mistake, my bad.


+-------------------------------------------------------------------+
|Filename: Import Shouwing 2.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3945 |
+-------------------------------------------------------------------+
 
D

Dave Peterson

First, the attachments in excelforum only help those that connect through the
excelforum web site. I connect directly to the MS NewsServers--so I don't even
see them.

If you go to the VBE, select that procedure and hit F8 to step through it, what
bad things happen and on what lines?
 
L

Lava

Okay I found the mistake (stupid me) coz I declared myCol as Rang
instead of Long. However, the solution doesn't work....

With the solution given it will fill the colum on which the activecel
is at that moment. So if I am in the 2nd column it'll fill the blank
there and if I'm in the 3rd column it'll fill that one. But not al
columns I wish in one go without having to select one.

Also, one big problem remains the same. With the first column th
filling will be done nicely. But any other column but the first on
will literally be filled with "=R[-1]C" as value. I dunno why thi
procedure ONLY works with the first column
 
C

Chip Pearson

When VBA encounters a problem, it display a dialog box with a
button labeled 'Debug'. Click this button and you will be take to
the offending line of code. That line will be highlighted in
yellow.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


in message
news:[email protected]...
 
D

Dave Peterson

First, you can select multiple cells, then run the macro. Just click on a cell
and ctrl-click on subsequent. The program will use each column that you
selected.

And if the cell is formatted as text, then the code could break. You could add
one line:

Option Explicit
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim myRng As Range
Dim myCell As Range
Dim myCol As Long

Set wks = Worksheets("Data Schouwing")

With wks
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

Set myRng = Intersect(Selection.EntireColumn, .Rows(1))

For Each myCell In myRng.Cells
myCol = myCell.Column

Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, myCol), .Cells(LastRow, myCol)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
'no more msgbox and don't exit sub
'MsgBox "No blanks found"
'Exit Sub
Else
rng.numberformat = "General" '<---- Added
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, myCol).EntireColumn
.Value = .Value
End With

Next myCell
End With
End Sub

ps. If you change the code (like "dim mycol as range"), then it's best to post
your code in the follow up.
Okay I found the mistake (stupid me) coz I declared myCol as Range
instead of Long. However, the solution doesn't work....

With the solution given it will fill the colum on which the activecell
is at that moment. So if I am in the 2nd column it'll fill the blanks
there and if I'm in the 3rd column it'll fill that one. But not all
columns I wish in one go without having to select one.

Also, one big problem remains the same. With the first column the
filling will be done nicely. But any other column but the first one
will literally be filled with "=R[-1]C" as value. I dunno why this
procedure ONLY works with the first column.
 
L

Lava

Copied your code and it worked well. To avoid the need to make
selection I replaced one line which I made "bold" in the code below t
indicate a pre-selection of Range A1:B2 since those columns need to b
checked for the time being. Let's see if I will need a followup post o
if things work out now :)

Thanks


Code
-------------------
Option Explicit
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim myRng As Range
Dim myCell As Range
Dim myCol As Long

Set wks = Worksheets("Data Schouwing")

With wks
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

' Set myRng = Intersect(Selection.EntireColumn, .Rows(1)) <-- commented
*Set myRng = Intersect(Range("A1:B2"), .Rows(1))* ' <-- changed

For Each myCell In myRng.Cells
myCol = myCell.Column

Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, myCol), .Cells(LastRow, myCol)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
'no more msgbox and don't exit sub
'MsgBox "No blanks found"
'Exit Sub
Else
rng.numberformat = "General" '<---- Added
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, myCol).EntireColumn
.Value = .Value
End With

Next myCell
End With
End Su
 
D

Dave Peterson

Glad it worked (so far)!
Copied your code and it worked well. To avoid the need to make a
selection I replaced one line which I made "bold" in the code below to
indicate a pre-selection of Range A1:B2 since those columns need to be
checked for the time being. Let's see if I will need a followup post or
if things work out now :)

Thanks

Code:
--------------------
Option Explicit
Sub FillColumnBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim myRng As Range
Dim myCell As Range
Dim myCol As Long

Set wks = Worksheets("Data Schouwing")

With wks
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

' Set myRng = Intersect(Selection.EntireColumn, .Rows(1)) <-- commented
*Set myRng = Intersect(Range("A1:B2"), .Rows(1))* ' <-- changed

For Each myCell In myRng.Cells
myCol = myCell.Column

Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, myCol), .Cells(LastRow, myCol)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
'no more msgbox and don't exit sub
'MsgBox "No blanks found"
'Exit Sub
Else
rng.numberformat = "General" '<---- Added
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, myCol).EntireColumn
.Value = .Value
End With

Next myCell
End With
End Sub
 

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

Top