Macro which counts up each time.

[Ayral]

Hey, I am new-ish to excel and we are using it for our school coursework, I wish to create a macro which copies data (customer data) from one sheet into another. The first sheet would be a template called "New_Customer" and the second sheet would be called "All-Customers" The problem is that i have a field called "Customer Id:" which should contain a number, and after the data is copied to the other sheet, and cleared (using another macro) it will display a new number - One more than the previous.

For example. The first customer enters their data in the "New_Customer" Sheet, the customer ID should display "1", after they press the button to save and add it to the 2nd sheet, and then the clear button the customer ID should automatically display "2" So if it is easier to add the +1 macro to the clear button that would help.

I have probably over complicated something very simple

Any help if greatly appreciated!

 

[Ozzieextreme]

Hi Ayral,

Depends on exactly how you need this to work, but if all you need to do is add one to the count each time this runs, you could add the following code to your macro:

Range("A1").Value = ActiveCell.Value + 1

Where A1 would be your Customer Number for example.

Hope this helps,

Oz

 

[Telefonstolpe]

Hi,

Hopefully I understood your question correctly...
I've made a code where the customer information is in range (B1:B5), and in which customer number is in cell B1.

Test the Macro below by inserting it into a blank workbook
Name the sheets: "New_Customer" & "All_Customers"
In sheet "New Customer" add value 1 in cell B1, and some optional data in range (B2:B5)
Run the Macro




The green text expains what happens through the marco...

Sub Paste_Data_Into_All_Customers()


'Select sheet "New_Customer"
Sheets("New_Customer").Select

'Stop the Macro from running if user haven't filled in all data
If Application.WorksheetFunction.CountA(Range("B2:B5")) <> 4 Then
MsgBox "You must fill in all customer information!"
Else

'Copy the customer data in sheet "New_Customer"
Range("b1:b5").Select
Selection.Copy

'Enter Sheet "All_Customers"
Sheets("All_Customers").Select

'Make sure that the data gets pasted into an empty row
Range("A" & Rows.Count).End(xlUp).Offset(1).Select

'Paste the data with "transpose" (That is: You copied as a column but you will paste as a row)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

'Go back to sheet "New_Customer" and add 1 to the the customer number
Sheets("New_Customer").Select
Range("b1").Value = 1 + Range("b1").Value

'Delete contents in other rows
Range("b2:b5").Select
Selection.ClearContents
End If
End Sub

Good Luck/Chris

 

[Ayral]

Hey thanks for the replies, Oz and Chris. Tried that code Chris and it seems to work perfectly, In my actual worksheet I have data in the cells; D14,D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G24,G26, With customer ID being the value in cell D14. Then, a new row would be inserted in row "A13" of the "All_customer" page shifting the existing data down, and then pasting in the values of the New-Customer page. What values would I change to make this work? The customer ID is in cell A13 of the new page if that helps. I like the error message saying everything must be filled in, that's awesome! What values would I need to change in order for the code to work? Thanks for your help!
-Ayral

 

[Telefonstolpe]

Hi There,

I think this code should do the trick...

Sub Paste_Data_Into_All_Customers()


'Select sheet "New_Customer"
Sheets("New_Customer").Select


'Stop the Macro from running if user haven't filled in all data
If Application.WorksheetFunction.CountA(Range("D16,D18,D20,D22,D24,D26")) <> 6 Then
MsgBox "You must fill in all customer information!"
Else


'Enter Sheet "All_Customers"
Sheets("All_Customers").Select


'Insert a new row in row 13
Rows("13:13").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Select sheet "New_Customer"
Sheets("New_Customer").Select


'Copy the customer data in sheet "New_Customer"
Range("D14,D16,D18,D20,D22,D24,D26").Select
Selection.Copy
       
'Enter Sheet "All_Customers"
Sheets("All_Customers").Select
Range("A13").Select


'Paste the data with "transpose" (That is: You copied as a column but you will paste as a row)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


'Go back to sheet "New_Customer" and add 1 to the the customer number
Sheets("New_Customer").Select
Range("D14").Value = 1 + Range("D14").Value


'Delete contents in other rows
Range("D16,D18,D20,D22,D24,D26").Select
Selection.ClearContents
End If
End Sub

/Chris

 

[Ayral]

Thank you Chris! That works!, it creates a new column and inserts the data, however it doesn't copy everything, it left out the data in the "G" column, can you fix this please?, I would attempt it but I would probably break the macro I need the data in cells, : D14,D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G24,G26
Again thanks for all the help!
- Ayral

 

[Telefonstolpe]

Here you go...

Sub Paste_Data_Into_All_Customers()




'Select sheet "New_Customer"
Sheets("New_Customer").Select




'Stop the Macro from running if user haven't filled in all data
If Application.WorksheetFunction.CountA _
(Range("D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G22,G24,G26")) <> 14 Then
MsgBox "You must fill in all customer information!"
Else


'Enter Sheet "All_Customers"
Sheets("All_Customers").Select


'Insert a new row in row 13
Rows("13:13").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Copy the Column D data in sheet "New_Customer"
Sheets("New_Customer").Select
Range("D14,D16,D18,D20,D22,D24,D26").Select
Selection.Copy
'Paste the Column D data in sheet "All_Customers"
Sheets("All_Customers").Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


'Copy the Column G data in sheet "New_Customer"
Sheets("New_Customer").Select
Range("G12,G14,G16,G18,G20,G22,G24,G26").Select
Selection.Copy
'Paste the Column G data in sheet "All_Customers"
Sheets("All_Customers").Select
Range("H13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A13:O13").Select


'Go back to sheet "New_Customer" and add 1 to the the customer number
Sheets("New_Customer").Select
Range("D14").Value = 1 + Range("D14").Value


'Delete contents in other rows
Range("D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G22,G24,G26").Select
Selection.ClearContents
Range("D16").Select


End If
End Sub

/Chris

 

[Ayral]

Thank you so much!
I accidentally made a mistake when I told you what data I needed sorry! Its D14,D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20. NOT G22 (its a tick box but the true false value is in cell g23) G23 (the true false value) and lastly G24. When I tried the code it worked, but after changing the data to be copied it says I must fill in every field, that's because I no-longer copy the tick boxes.
EDIT: Actually the data in G23 - The true false values, are formatted in white so the customer cant see it when filling it out, they just see the tick box. Can the data be pasted into the second sheet as normal black text? If this cant be added to the macro its no worries, i could just format it before the data is copied. Sorry for all the hassle!
Thanks Again
-Ayral

 

[Telefonstolpe]

Hi there, code below should work,

1. I made it so the Code doesn't delete G23 at the end of the Macro... suppose its how you want it.
2. Regarding the white formatting in Cell G23 it shouldn't get white in All_Customers since the macro pastes only values and not formats.
If the format of this cell still is white in All_Customers sheet check the formats and conditional formats in All_Customers sheet.

Sub Paste_Data_Into_All_Customers()


'Select sheet "New_Customer"
Sheets("New_Customer").Select


'Stop the Macro from running if user haven't filled in all data
If Application.WorksheetFunction.CountA _
(Range("D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G23,G24")) <> 13 Then
MsgBox "You must fill in all customer information!"
Else
Application.EnableEvents = False


'Enter Sheet "All_Customers"
Sheets("All_Customers").Select


'Insert a new row in row 13
Rows("13:13").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Copy the Column D data in sheet "New_Customer"
Sheets("New_Customer").Select
Range("D14,D16,D18,D20,D22,D24,D26").Select
Selection.Copy
'Paste the Column D data in sheet "All_Customers"
Sheets("All_Customers").Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


'Copy the Column G data in sheet "New_Customer"
Sheets("New_Customer").Select
Range("G12,G14,G16,G18,G20,G23,G24").Select
Selection.Copy
'Paste the Column G data in sheet "All_Customers"
Sheets("All_Customers").Select
Range("H13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A13:N13").Select


'Go back to sheet "New_Customer" and add 1 to the the customer number
Sheets("New_Customer").Select
Range("D14").Value = 1 + Range("D14").Value


'Delete contents in other rows
Range("D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G24").Select
Selection.ClearContents
Range("D16").Select


Application.EnableEvents = True
End If
End Sub

You can protect your New Customer Sheet if you want:

1. Mark all cells > Format cells > Protection > Lock
2. Mark cells D16,D18,D20,D22,D24,D26,G12,G14,G16,G18,G20,G23,G24 > Format cells > Protection > Unlock
3. Review > Protect Sheet > Only allow "Select unlocked Cells" > Ok
4. right-click the New Customer Tab > Click View Code
5. Paste Code Below into the object you just opened

Private Sub Worksheet_SelectionChange(ByVal target As Range)


If target.Address = "$D$14" Then
Range("D16").Select
Else
If target.Address = "$G$23" Then
Range("G24").Select
Else
Exit Sub
End If
End If
End Sub

Chris

 

[Telefonstolpe]

Some more info...

While working in the sheet yourself you should of course have it unprotected and disable the Selection_Change Code.
You can do that by for example add an extra character in the headings of the Code:

Private Sub Worksheet_SelectionChangeX(ByVal target As Range)

Chris