Auto generate numbers

hello, I know this has been talked about many of times here but I can't find a solution that fits what I need. I have created this macro for my company and everything works great but the way I have it now each one of my locations enters there our "Collection #" in my macro. That has led to them entering duplicate numbers. I would like to be able to have the macro auto generate a number into this cell 'G2" for them starting at 0001. Then next time they open it it would enter 0002 and so on. I have tried different methods to no avail. below is the code for the macro. Thank you so much for any help.

Private Sub cmdOK_Click()

Dim ws As Worksheet
Set ws = Worksheets("Collections")

'check for a date
If Trim(Me.txtDate.Value) = "" Then
  Me.txtDate.SetFocus
  MsgBox "Please enter Todays Date"
  Exit Sub
End If

'check for their collection #
If Trim(Me.txtCollNum.Value) = "01-" Then
  Me.txtCollNum.SetFocus
  MsgBox "Please enter your Collection #"
  Exit Sub
End If

'check for a collection receipt
If Trim(Me.txtReceiptA.Value) = "" Then
  Me.txtReceiptA.SetFocus
  MsgBox "Please enter Collection Recipients Name"
  Exit Sub
End If

'check for item date
If Trim(Me.txtItem.Value) = "" Then
  Me.txtItem.SetFocus
  MsgBox "Please enter the Items Date"
  Exit Sub
End If

'check for a payer
If Trim(Me.txtPayer.Value) = "" Then
  Me.txtPayer.SetFocus
  MsgBox "Please enter a Payer"
  Exit Sub
End If

'check for description
If Trim(Me.txtDescription.Value) = "" Then
  Me.txtDescription.SetFocus
  MsgBox "Please enter a Description"
  Exit Sub
End If

'check for a amount
If Trim(Me.txtAmount.Value) = "" Then
  Me.txtAmount.SetFocus
  MsgBox "Please enter an Amount"
  Exit Sub
End If

'check for instructions
If Trim(Me.txtInstructions.Value) = "" Then
  Me.txtInstructions.SetFocus
  MsgBox "Please enter Payment Instructions"
  Exit Sub
End If

'copy the data to the form
ws.Range("A2").Value = Me.txtDate.Value
ws.Range("E2").Value = Me.txtReceiptA.Value
ws.Range("E3").Value = Me.txtReceiptB.Value
ws.Range("E4").Value = Me.txtReceiptC.Value
ws.Range("G2").Value = Me.txtCollNum.Value
ws.Range("A7").Value = Me.txtItem.Value
ws.Range("A8").Value = Me.txtCheck.Value
ws.Range("B7").Value = Me.txtPayer.Value
ws.Range("D7").Value = Me.txtDescription.Value
ws.Range("G7").Value = Me.txtDue.Value
ws.Range("H7").Value = Me.txtAmount.Value
ws.Range("B10").Value = Me.txtDestinationA.Value
ws.Range("B11").Value = Me.txtDestinationB.Value
ws.Range("B12").Value = Me.txtDestinationC.Value
ws.Range("D11").Value = Me.txtInstructions.Value

'clear the data
Me.txtDate.Value = ""
Me.txtReceiptA.Value = ""
Me.txtReceiptB.Value = ""
Me.txtReceiptC.Value = ""
Me.txtCollNum.Value = ""
Me.txtItem.Value = ""
Me.txtCheck.Value = ""
Me.txtPayer.Value = ""
Me.txtDescription.Value = ""
Me.txtDue.Value = ""
Me.txtAmount.Value = ""
Me.txtDestinationA.Value = ""
Me.txtDestinationB.Value = ""
Me.txtDestinationC.Value = ""
Me.txtInstructions.Value = ""
Me.txtDate.SetFocus

 Unload Me

End Sub