# Customer database



## Artemis of the moon (Dec 26, 2022)

Hi everybody! 

I would like to create an excel workbook with on sheet 1, in A1 I'd have a cell in which I could put a name that would automatically add to sheet 2 but to the cell A1 +1.
Not sure if it's clear. 

The idea would be to have a sort of customer's infos filling page (sheet 1) that would automatically filled my customers database (sheet 2).
For example, I write John in A1 sheet 1 and it writes down John in A2 sheet 2. Then if deleted John in A1 sheet 1 and I write Michael instead. Michael would automatically writes down in A3 sheet 2.

Don't hesitate to say if it's not clear >_<
And thanks for the help!


----------



## breynolds0431 (Dec 26, 2022)

Hi. The below should achieve what you've indicated if I'm following correctly. Add this to your input sheet's (Sheet1) module. 


```
Private Sub Worksheet_Change(ByVal Target As Range)
    
'variable declarations
Dim wb As Workbook: Set wb = ThisWorkbook
Dim inputWS As Worksheet: Set inputWS = wb.Sheets("Sheet1")
Dim dbaseWS As Worksheet: Set dbaseWS = wb.Sheets("Sheet2")
Dim kCell As Range: Set kCell = inputWS.Range("A1")
Dim lrow As Long

'catches a change to kCell
If Not Application.Intersect(kCell, Range(Target.Address)) Is Nothing Then
    'will only record name if kCell is not blank
    If Not kCell.Value = "" Then
        'finds next open row in dbaseWS
        If dbaseWS.Cells(1, 1).Value = "" Then
            'will assign first row if no data in dbaseWS yet
            lrow = 1
        Else
            'will assign next open row if dbaseWS has data
            lrow = dbaseWS.Cells(dbaseWS.Rows.Count, 1).End(xlUp).Row + 1
        End If
        dbaseWS.Cells(lrow, 1).Value = kCell.Value
    End If
End If

End Sub
```


----------



## Artemis of the moon (Dec 26, 2022)

breynolds0431 said:


> Hi. The below should achieve what you've indicated if I'm following correctly. Add this to your input sheet's (Sheet1) module.
> 
> 
> ```
> ...


Thanks, I'll try that tomorrow 🌿


----------



## Artemis of the moon (Dec 27, 2022)

breynolds0431 said:


> Hi. The below should achieve what you've indicated if I'm following correctly. Add this to your input sheet's (Sheet1) module.
> 
> 
> ```
> ...



I tried adding it but it didn't work.
Does it have to be on a specific Excel version?


----------



## breynolds0431 (Dec 27, 2022)

It should work in any version. Did just nothing happen or did you receive a debug error? 

Can you confirm that you have the code in the Sheet1 module such as below?


----------



## Artemis of the moon (Dec 27, 2022)

Ok!
I think I managed to add it to my module as showed in my screenshot and it works!
This is lovely!
I just changed the name of the sheet so they're the same as my french version 😅

And if I want to add a macro that does the same to B1 sheet 1 (like a last name), do I just have to copy paste the same VBA code underneath the first one and just change the cell name from "A1" to "B1"?
Or do I have to do something more?

It's really nice of you to help! I'm quite new to all that but the applications seem limitless 😂
Thanks


----------



## breynolds0431 (Dec 27, 2022)

Hi. For two fields using this method, you'd have to be careful because there's the potential for your database to have a mismatch of first and last names should a mistake be made. 

I've included two options below. 

The first is using the same worksheet_change event that I've modified to include cells A1 and B1 on Feuil1 to capture the first and last names. Again, this is the more risky option where a mismatch could easily occur in your database. 


```
Private Sub Worksheet_Change(ByVal Target As Range)
    
'variable declarations
Dim wb As Workbook: Set wb = ThisWorkbook
Dim inputWS As Worksheet: Set inputWS = wb.Sheets("Feuil1")
Dim dbaseWS As Worksheet: Set dbaseWS = wb.Sheets("feuil2")
Dim kCell As Range: Set kCell = inputWS.Range("A1:B1")
Dim lrow As Long

'catches a change to kCell
If Not Application.Intersect(kCell, Range(Target.Address)) Is Nothing Then
    'Since there are now two fields, need to make sure that the code stops if
    'there are more than one cells selected to avoid debug (i.e.; cells.count > 1)
    If Not Selection.Cells.Count > 1 Then
        'will only record name if kCell is not blank
        If Not Target.Value = "" Then
            'finds next open row in dbaseWS
            If Target.Column = 1 Then
                'Captures change to column 1 for first name
                If dbaseWS.Cells(1, 1).Value = "" Then
                    'will assign first row if no data in dbaseWS yet
                    lrow = 1
                Else
                    'will assign next open row if dbaseWS has data
                    lrow = dbaseWS.Cells(dbaseWS.Rows.Count, 1).End(xlUp).Row + 1
                End If
                dbaseWS.Cells(lrow, 1).Value = Target.Value
            ElseIf Target.Column = 2 Then
                'Captures change to column 2 for last name
                If dbaseWS.Cells(1, 2).Value = "" Then
                    'will assign first row if no data in dbaseWS yet
                    lrow = 1
                Else
                    'will assign next open row if dbaseWS has data
                    lrow = dbaseWS.Cells(dbaseWS.Rows.Count, 2).End(xlUp).Row + 1
                End If
                dbaseWS.Cells(lrow, 2).Value = Target.Value
            End If
        End If
    End If
End If

End Sub
```
 
And the second is to use a way for the user to confirm their submission. This will be done using a button on the Feuil1, which will write the names to Feuil2. 

On the actual Feuil1, you'd want go to the Developer tab and insert a button, see below. Then draw the button in cell C1 or D1, which ever is better for you. After you draw the button, you should see a "Assign Macro" dialog display. Click *New*. You'll be taken to a newly created normal Module (not associated with any specific sheet) where you can add the below code to. This should ensure that the same customer's first and last name appear on the same row of the database (Feuil2). 







```
Sub Button1_Click()

'variable declarations
Dim wb As Workbook: Set wb = ThisWorkbook
Dim inputWS As Worksheet: Set inputWS = wb.Sheets("Feuil1")
Dim dbaseWS As Worksheet: Set dbaseWS = wb.Sheets("feuil2")
Dim lrow As Long

'Will require both a first name and last name
If inputWS.Cells(1, 1) = vbNullString Or inputWS.Cells(1, 2) = vbNullString Then
    MsgBox "Please include both a first and last name before continuing." _
        , vbCritical, "Missing Data"
    Exit Sub
End If

'Determines row to paste new customer data in
If dbaseWS.Cells(1, 1).Value = "" Then
    'will assign first row if no data in dbaseWS yet
    lrow = 1
Else
    'will assign next open row if dbaseWS has data
    lrow = dbaseWS.Cells(dbaseWS.Rows.Count, 1).End(xlUp).Row + 1
End If
dbaseWS.Cells(lrow, 1).Value = inputWS.Cells(1, 1)
dbaseWS.Cells(lrow, 2).Value = inputWS.Cells(1, 2)

End Sub
```


----------



## Artemis of the moon (Dec 27, 2022)

breynolds0431 said:


> Hi. For two fields using this method, you'd have to be careful because there's the potential for your database to have a mismatch of first and last names should a mistake be made.
> 
> I've included two options below.
> 
> ...


That's awesome thanks!
I updated a bit the code to have more columns 

Here's my code, still very simple.

```
Sub Bouton2_Cliquer()

'variable declarations
Dim wb As Workbook: Set wb = ThisWorkbook
Dim inputWS As Worksheet: Set inputWS = wb.Sheets("Feuil1")
Dim dbaseWS As Worksheet: Set dbaseWS = wb.Sheets("feuil2")
Dim lrow As Long

'Will require both a first name and last name and phone number and email and adress
If inputWS.Cells(9, 2) = vbNullString Or inputWS.Cells(9, 3) = vbNullString Or inputWS.Cells(9, 4) = vbNullString Or inputWS.Cells(9, 5) = vbNullString Or inputWS.Cells(9, 6) = vbNullString Then
    MsgBox "Remplissez toutes les informations!" _
        , vbCritical, "Missing Data"
    Exit Sub
End If

'Determines row to paste new customer data in
If dbaseWS.Cells(1, 1).Value = "" Then
    'will assign first row if no data in dbaseWS yet
    lrow = 1
Else
    'will assign next open row if dbaseWS has data
    lrow = dbaseWS.Cells(dbaseWS.Rows.Count, 1).End(xlUp).Row + 1
End If
dbaseWS.Cells(lrow, 1).Value = inputWS.Cells(9, 2)
dbaseWS.Cells(lrow, 2).Value = inputWS.Cells(9, 3)
dbaseWS.Cells(lrow, 3).Value = inputWS.Cells(9, 4)
dbaseWS.Cells(lrow, 4).Value = inputWS.Cells(9, 5)
dbaseWS.Cells(lrow, 5).Value = inputWS.Cells(9, 6)

End Sub
Sub Effacer()
'
' Effacer Macro
'

'
    Range("B9:F9").Select
    Selection.ClearContents
End Sub
```


----------



## breynolds0431 (Dec 27, 2022)

Looks good. Glad I was able to help


----------

