Macro which counts up each time.

A

Ayral

New Member
Joined
Oct 3, 2014
Messages
49
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 :rolleyes:

Any help if greatly appreciated!:biggrin:
 
Sort by date Sort by votes
Thanks Chris thats perfect.
I have conditional formatting in the cell N13 which says =IF(M13=TRUE,1,0) and also =IF(M13=FALSE,1,0) The colour for false isRed: 146 Green: 208 Blue: 80 and the colour for true is Red: 230 Green: 184 Blue:183, Is it possible to add this to the macro, that when the data is copied to the all customer page, the conditional formatting is added to? because at the minute the colour wont show and i have to manually add the conditional formatting rule, or add it to the whole collum, which displays every cell as green.
Thanks again
- Ayral
 
Last edited:
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Hello, heres the new code...


Code: 
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


' Conditional Formatting in Cell N13
Range("N13").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=FALSE"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -11480942
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=TRUE"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -4736794
End With
Selection.FormatConditions(1).StopIfTrue = False
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


A Tip:

Maybe you don't want the answer in Cell G23 to Be "TRUE" or FALSE", Maybe you want it to be for example: "Yes" or "No"....
In that case, one thing you can to is this:

1. Move the TRUE or FALSE value from G23 to an empty cell... let's say "A1" in this example....
2. Put the following if statement in cell G23: =if($A$1=TRUE;"Yes";"No")
3. Change the Code in the Macro: From Formula1:="=$M$13=TRUE" to Formula1:="=$M$13=""Yes"""
4. Change the Code in the Macro: From Formula1:="=$M$13=FALSE" to Formula1:="=$M$13=""No"""


/Chris
 
Upvote 0
Sorry to be such a pain, its the background colour I meant not the text, and is it possible to include the "all boarders" around the data which has been pasted, A13;N13 and also make it unbold, as the data above is bold it makes the new data bold. Thanks again
 
Upvote 0
Hi

I also changed the background colour to white in A13:N13 by adding this Code into the macro: Selection.Interior.Color = RGB(255, 255, 255)
Of course you can remove it or change the RGB numbers if you want another colour.

Good luck!


Code: 
Sub Paste_Data_Into_All_Customers()
Application.EnableEvents = False
Application.ScreenUpdating = False


'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!"
End If


'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


' Conditional Formatting in Cell N13
Range("N13").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=FALSE"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = RGB(146, 208, 80)
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=TRUE"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = RGB(230, 184, 183)
End With
Selection.FormatConditions(1).StopIfTrue = False


'Edit Format in Pasted Cells
Range("A13:N13").Select
Selection.Font.Bold = False
Selection.Interior.Color = RGB(255, 255, 255)
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


'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


'Finish
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Chris
 
Upvote 0
I feel like such an idiot, but i think i managed to break it :rolleyes:
The value in cell G24 is optional if the tick box in g22 is ticked (saying yes/no in g23 - the value which is copied) If it is yes, they fill it in, if not they leave it blank, and the conditional formatting changes colour accordingly, but when I took out the "G24" From the code and changed the 13 to a 12, the message "you must fill in all customer data" appears, but still copies the customer ID across with blank data if I press the button right away, does it need to remain with the number 13? (this is the last question I promise haha!)
Code: 
Sub Paste_Data_Into_All_Customers()Application.EnableEvents = False
Application.ScreenUpdating = False




'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")) <> 12 Then
MsgBox "You must fill in all customer information!"
End If




'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




' Conditional Formatting in Cell N13
Range("N13").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=""No"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = RGB(146, 208, 80)
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=""Yes"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = RGB(230, 184, 183)
End With
Selection.FormatConditions(1).StopIfTrue = False




'Edit Format in Pasted Cells
Range("A13:N13").Select
Selection.Font.Bold = False
Selection.Interior.Color = RGB(255, 255, 255)
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With




'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




'Finish
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi,

My fault. When I edited the code i forgot to restore an essential command that was there before: "Exit sub"
(which basically means that if the messagebox shows the macro shall not run the rest of the code)


Green text shows the data that should be added added into the macro:

'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")) <> 12 Then
MsgBox "You must fill in all customer information!"
1. Application.EnableEvents = True
2. Application.ScreenUpdating = True
3. Exit Sub
End If

1. Before running the main code the macro disabled other events from disturbing the code with Application.EnableEvents = False.
Before exiting sub they must be restored with Application.EnableEvents = True
2. Same thing with Application.ScreenUpdating = False (This makes the screen stop flickering while code is running)
3. Finally the command exit sub stops the rest of the macro from running



This code below shows a message box also if user answers yes in G23 but does not fill in anything in G24:
Code: 
Sub Paste_Data_Into_All_Customers()
Application.EnableEvents = False
Application.ScreenUpdating = False




'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")) <> 12 Then
MsgBox "You must fill in all customer information!"
Application.EnableEvents = False
Application.ScreenUpdating = False
Exit Sub
End If
If Range("G23").Value = "Yes" And Range("G24").Value = "" Then
MsgBox "You must fill in all customer information!"
Application.EnableEvents = False
Application.ScreenUpdating = False
Exit Sub
End If


'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


' Conditional Formatting in Cell N13
Range("N13").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=FALSE"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = RGB(146, 208, 80)
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$M$13=TRUE"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = RGB(230, 184, 183)
End With
Selection.FormatConditions(1).StopIfTrue = False


'Edit Format in Pasted Cells
Range("A13:N13").Select
Selection.Font.Bold = False
Selection.Interior.Color = RGB(255, 255, 255)
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


'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


'Finish
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Excel VBA - Sort & Get Totals - Logic
Replies
4
Views
325
STARL0RD
S
N
  • Question Question
macro to filter spreadsheet by customer code, send relevant data via email
Replies
2
Views
485
Peter_SSs
Peter_SSs
D
  • Solved
Custom UI Tab Not Working
Replies
7
Views
722
Dman333
D
A
  • Solved
COUNT multiple SUM COUNTIFS
Replies
6
Views
122
Peter_SSs
Peter_SSs
I
  • Solved
Master Quotation Worksheet saving Quotes (Macro Enabled)
Replies
2
Views
368
ianharper68
I

Forum statistics

Threads
1,223,101
Messages
6,170,116
Members
452,302
Latest member
TaMere

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top