Data Entry Form: Macro-One To Many

[Qull666]

Data Entry Form: Macro-One To Many

I am a real macro dummy!!! Hope that a helping hand is extended. Thank you.

It is for an Account Payable Model:

2 Sheets: Payment and Database

--This is what I do----
Step 1: Cell A1: Enter Payee Name
Step 2: Cell A2: Enter Payment Reference
Step 3: Cells D2 to D6 (may go up to more than 5 bills) will automatic list.

Payment
-----A---------B----------C---------D---------E
1----XYZ Ltd----------------------------------
2----PV-1234----------------------Bill 1----
3-----------------------------------Bill 2----
4-----------------------------------Bill 3----
5-----------------------------------Bill 4----
6-----------------------------------Bill 5----


The Macro I am looking for: Transfers information of A & D to the format
below.

Database
-----A----------------B
1----PV-0123--------Earlier Bill
2----PV-0123--------Earlier Bill
3----PV-1234--------Bill 1 <------here!!!
4----PV-1234--------Bill 2
5----PV-1234--------Bill 3
6----PV-1234--------Bill 4
7----PV-1234--------Bill 5


I have attached the script in hope that it will help to pin-point exactly
what I am trying to do. (I got this from a Dave Peterson's website)


Sub UpdateLogWorksheet()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Input sheet - some contain formulas
myCopy = "B2,B3,B4,B5"

Set inputWks = Worksheets("Payment")
Set historyWks = Worksheets("Payment")

With historyWks
nextRow = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0).Row
End With

With inputWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Fill in all the cells, first!"
Range("D2").Select
Exit Sub
End If
End With

With historyWks
With .Cells(nextRow, "K")
'.Value = Now
'.NumberFormat = "mm/dd/yyyy hh:mm:ss"
'.Cells(nextRow, "B").Value = Application.UserName
oCol = 11 ' set to 1 instead of 3

For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
End With

'clear input cells that contain constants
'With inputWks
' On Error Resume Next
' With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
' .ClearContents
' Application.GoTo .Cells(1) ', Scroll:=True
' End With
' On Error GoTo 0
'End With


'Selective Clear Input Celss
With inputWks
On Error Resume Next
With Range("B2:B15,D225").Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1)
Range("B2").Select

End With
On Error GoTo 0
End With



End Sub


Thank you.

 

[Dave Peterson]

First, watch out for these lines:

Set inputWks = Worksheets("Payment")
Set historyWks = Worksheets("Payment")

Your history and input are pointing to the same worksheet!

Second, ...

I'd add a step that fills in those empty cells in the Payment worksheet before
doing the copying to the Database worksheet.

Debra Dalgleish has some code for that, too:
http://contextures.com/xlDataEntry02.html

So you could have two, er, three routines.

The first routine calls the other two:

Sub DoBoth()
call FillColBlanks 'fix this to do both columns the way you want.
call UpdateLogWorksheet
End sub

 

[Qull666]

Thanks Dave,

Database column A is taken care of using the link. The script I am currently
trying to learn is for another model, similar to this (evolution) but it
works on a row basis.

Your link will fill the blank cells in column A.
-----This is done----------


Missing link: is to get Payment column D to fill the row in column B in
Database.

Sometimes one payment can match to more than 1 bills. I know this can be
done by updating the Database itself.

Data entry models are something I have been trying to learn, and couldn't
have done it without your scripts. (you started it, hahaha!!!)

By the way, most of the modification of your scripts was done by Howard
Kittle, but I can't seem to grab hold of him.


I know this is crazy, but experimental. This is the actual code in the
script. Same worksheet, different columns.

Set inputWks = Worksheets("Payment") ------> myCopy = "B2,B3,B4,B5"
Set historyWks = Worksheets("Payment") -----> K onwards.

The codes are flexible enuff to do this!!!! lol.


TRYING TO BUILD:

From Payment
-----A---------B----------C---------D---------E
1----XYZ Ltd----------------------------------
2----PV-1234----------------------Bill 1----
3-----------------------------------Bill 2----
4-----------------------------------Bill 3----
5-----------------------------------Bill 4----
6-----------------------------------Bill 5----

In Column D of Payment Sheet (data input), there is a reference formula.
=IF(ISERROR(VLOOKUP(SMALL('A-C Mth'!G:G,ROWS(Payment!$F$1:F1)),'A-C
Mth'!G:H,2,FALSE)),"",VLOOKUP(SMALL('A-C Mth'!G:G,ROWS(Payment!$F$1:F1)),'A-C
Mth'!G:H,2,FALSE))



I am tring to get this:

TO Database

+----Using Fill Blank Cells--------Missing Link

-----A--------------B----------------C
1----PV-1234-------XYZ Ltd-----------Bill 1
2------------------------------------Bill 2
3------------------------------------Bill 3
4------------------------------------Bill 4
5------------------------------------Bill 5



Extract of the codes:
'cells to copy from Input sheet - some contain formulas
myCopy = "A1,A2,D2,D3,D4,D5,D6"

<Can I change the range from A1,A2, D, E:E? >

<if possible, the whole of column D (or) Column D & E>


For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell


Current Result: This will copy by col.

Database
-----A--------------B-------C-------D---------E----------F-----
1----PV-1234--------Bill 1--Bill 2--Bill 3----Bill 4-----Bill 5
2--------------------------------------------------------------
3--------------------------------------------------------------
4--------------------------------------------------------------
5--------------------------------------------------------------




I know this is a lot to ask for. Thank you, Dave.

 

[Dave Peterson]

I'm confused about what's going on.

From the first message, I thought the database would end up like:

Database
-----A----------------B
1----PV-0123--------Earlier Bill
2----PV-0123--------Earlier Bill
3----PV-1234--------Bill 1 <------here!!!
4----PV-1234--------Bill 2
5----PV-1234--------Bill 3
6----PV-1234--------Bill 4
7----PV-1234--------Bill 5

But now it ends up like:

Database
-----A--------------B-------C-------D---------E----------F-----
1----PV-1234--------Bill 1--Bill 2--Bill 3----Bill 4-----Bill 5

I would have thought that a minor modification to this portion would work:

With historyWks
With .Cells(nextRow, "K")
'.Value = Now
'.NumberFormat = "mm/dd/yyyy hh:mm:ss"
'.Cells(nextRow, "B").Value = Application.UserName
oCol = 11 ' set to 1 instead of 3

For Each myCell In myRng.Cells
if trim(mycell.value) = "" then
'do nothing
else
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
end if
Next myCell
End With
End With

But I'm confused at what you have and what you're trying to do.

 

[Qull666]

Dear Dave,

When I re-read it! its confusing!! My Apology, trying to stuff and shove in
everything!!.


The Part I am dumb with:
This is the part where I do not know how to modify the codes.

Currently the codes would transfer from
Payment----> Database in this structure (coz I really don't know how to
modify the codes).

Database
-----A--------------B-------C-------D---------E----------F-----
1----PV-1234------Bill 1---Bill 2--Bill 3----Bill 4-----Bill 5

************************************************




It's Still This:

Column A: Key In (manually)
Column D: Auto Reference

From Payment (Data Entry Form)
-----A---------B----------C---------D---------E
1----XYZ Ltd----------------------------------
2----PV-1234----------------------Bill 1----
3-----------------------------------Bill 2----
4-----------------------------------Bill 3----
5-----------------------------------Bill 4----
6-----------------------------------Bill 5----

When I hit the Save Data button, it will transfer to Database and clear cells.


RESULT:
Database
-----A----------------B
1----PV-0123--------Earlier Bill
2----PV-0123--------Earlier Bill
3----PV-1234--------Bill 1 <------here!!!
4----PV-1234--------Bill 2
5----PV-1234--------Bill 3
6----PV-1234--------Bill 4
7----PV-1234--------Bill 5

For Column A, I can use the 'fill blank cells link'.

For Column B: clueless!!!

Thanks for your patience.

 

[Dave Peterson]

I'm not sure how this fits in your existing code, but you could cycle through
the input range (look for non-blanks in column D and plop those values in column
B of the database worksheet.

I figured the first "id" started in A2 (headers in row 1) and had something in
it.

Dim myRng as range
Dim LastRow as long
dim myCell as range
dim DestCell as range
dim CurrentId as String

with inputwks
lastrow = .cells(.rows.count,"D").end(xlup).row
set myrng = .range("A2:A" & lastrow)
end with

with historywks
set destcell = .cells(.rows.count,"A").end(xlup).offset(1,0)
end with

for each mycell in myrng.cells
if trim(mycell.value) = "" then
'don't change CurrentID
else
currentid = mycell.value
end if

'plop in id from this row or from previous row
destcell.value = currentid
'plop in bill#
destcell.offset(0,1).value = mycell.offset(0,3).value

'get ready for next one
set destcell = destcell.offset(1,0)
next mycell


====
You might end up trashing lots of code to replace it with something like
this.

 

[Qull666]

Dear Dave,

Yes, First & Second ID in cell A1 and A2.

I thought a minor twitch to your existing code would do the trick. This is
like a major overhaul. hehehe!

I find that most macro helps are difficult as compared to =functions. And
its stressful for you guys too, who are trying to guess and figure out the
scenarios.

Last attempt, if it doesn't work, we will drop this and come back to it at a
later date. (handshake). Thanks.

There is a run-time error in the codes.

Sub UpdateLogWorksheet()

Dim myRng As Range
Dim LastRow As Long
Dim myCell As Range
Dim DestCell As Range
Dim CurrentId As String

'cells to copy from Input sheet - some contain formulas
'myCopy = "A2:A & LastRow"

Set inputWks = Worksheets("Payment")
Set historyWks = Worksheets("Database")
'-----------------------------------New Code

With inputWks
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
Set myRng = .Range("A2:A" & LastRow)
End With

With historyWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'don't change CurrentID
Else
CurrentId = myCell.Value
End If

'plop in id from this row or from previous row
DestCell.Value = CurrentId
'plop in bill#
DestCell.Offset(0, 1).Value = myCell.Offset(0, 3).Value

'get ready for next one
Set DestCell = DestCell.Offset(1, 0)
Next myCell

'----------------------------------------New Code

'With historyWks
'nextRow = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0).Row
'End With

'With inputWks
'Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Fill in all the cells, first!"
Range("D2").Select
Exit Sub
End If
'End With

With historyWks
With .Cells(nextRow, "A")
'.Value = Now
'.NumberFormat = "mm/dd/yyyy hh:mm:ss"
'.Cells(nextRow, "B").Value = Application.UserName
oCol = 1 ' set to 1 instead of 3

For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
End With

'clear input cells that contain constants
'With inputWks
' On Error Resume Next
' With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
' .ClearContents
' Application.GoTo .Cells(1) ', Scroll:=True
' End With
' On Error GoTo 0
'End With


'Selective Clear Input Cells
With inputWks
On Error Resume Next
With Range("A2:A" & LastRow).Cells.SpecialCells(xlCellTypeConstants)
..ClearContents
Application.GoTo .Cells(1)
Range("B2").Select

End With
On Error GoTo 0
End With

End Sub

 

[Dave Peterson]

First, add "Option Explicit" at the top of your module. This will force you to
declare all your variables.

But I think trying to mix the old code with the new code is messing things up.

And I changed the layout of the history worksheet.

Column A will contain the date/time of the run.
Column B will contain the Id.
Column C will contain the Bill id.

So try this against a copy of your workbook:

Option Explicit
Sub UpdateLogWorksheet()

Dim myRng As Range
Dim LastRow As Long
Dim myCell As Range
Dim DestCell As Range
Dim CurrentId As String
Dim InputWks As Worksheet
Dim HistoryWks As Worksheet

Set InputWks = Worksheets("Payment")
Set HistoryWks = Worksheets("Database")

With InputWks
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
Set myRng = .Range("A2:A" & LastRow)
End With

With HistoryWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

'check column D for all the values--not column A
'Since column A can have empty cells
'(Don't bother filling those cells anymore!)
If Application.CountA(myRng.Offset(0, 3)) <> myRng.Cells.Count Then
MsgBox "Fill in all the cells, first!"
Application.Goto InputWks.Range("D2")
Exit Sub
End If

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'don't change CurrentID
Else
CurrentId = myCell.Value
End If

With DestCell
'Column A
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
.Value = Now
'column B
.Offset(0, 1).Value = CurrentId
'column C
.Offset(0, 2).Value = myCell.Offset(0, 3).Value
End With
'get ready for next time
Set DestCell = DestCell.Offset(1, 0)
Next myCell

'Selective Clear Input Cells
On Error Resume Next
'clean up column A of the input worksheet
myRng.Cells.SpecialCells(xlCellTypeConstants).ClearContents
'clean up column D of the input worksheet
myRng.offset(0,3).Cells.SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
Application.Goto InputWks.Range("B2")

End Sub

 

[Qull666]

Dear Dave,

Thanks for the help. Did you know that I am using your old codes to:

1. Data Entry Form (ppl are impressed it can be done!!!)
2. Used as a log book to keep track of last entries----Pivot table to keep
Max number (reference). Then recall the last number +1 to it.

Hey! you are great. Thanks.

 

[Qull666]

Dear Dave,

The codes are working. Thank you again. Hey!! I really appreciate this.

 

[Dave Peterson]

Glad it worked (finally!). <bg>

Dear Dave,

The codes are working. Thank you again. Hey!! I really appreciate this.