Olá, tenho um código para contador de registros, mas preciso que ele zero todo inicio de mês.
Agradeço qualquer ajuda.
Segue código.
Private Sub Bt_Novo_Click()
Dim RData
Dim RMes
Dim ROrg
RData = Format(Date, "yy")
RMes = Format(Date, "mm")
LINHA = 2
Cont = 0
Do Until Sheets("BASE").Cells(LINHA, 1) = ""
Cont = Cont + 1
LINHA = LINHA + 1
Loop
FrmLancNc.txt_Numero.Text = RData & "" & RMes & "" & Cont
End Sub
Não entendi onde esta o problema .
Qual a dificuldade ?
Um arquivo de exemplo ajuda bastante entender
Marcelo Prudencio
"Começar já é a metade do caminho."
Autor Desconhecido
Simplifica que simples fica.
Nicole Tomazella.
"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.
MPrudencio
Oi, coloquei apenas o código referente ao contador.
O contador funciona normal, mas não consigo elaborar o código para zerar a contagem todo inicio de mês.
Anexei o arquivo.
O comando está no botão "Novo" do formulário "FrmLancNc".
Bom dia, Brano.
Zerar contador?
Já tentou fazer um if?
Seria algo mais ou menos assim:
Sub Teste_Dia()
Dim vDia As Long
vDia = Day(CDate(Now))
If vDia = 3 Then
MsgBox "Hoje é dia " & vDia & " o contador será zerado", vbCritical, "Atenção"
Else
MsgBox "O contador será mantido", vbInformation, "Atenção"
End If
End Sub
Se a resposta foi útil! Clique na mãozinha ao lado do botão Citar.
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. 
Não estou conseguindo motar a síntese.
Se meu contador normal é cont=cont+1, como ficaria a condição pra retornar ao 1 novamente?
Obrigado.
Boa noite,
Resolvi, porém de outra forma, ao invés de zerar o contador no final do mês, acrescentei uma coluna com valor de entra igual ao mês do registro, e através dela eu conto a quantidade de registros que ouve no mês corrente, sendo que ao mudar o mês ele começará a contar novamente os registros a partir do zero.
Segue o código do botão que irá chama o comando.
Obrigado a todos que me deram possíveis soluções.
abraços.
Private Sub Bt_Novo_Click()
Dim coluna
Dim origem
Dim DescOrigem As String
'Verifica se há seleção dos botões de opção
If OpBt_Almox = False And OpBt_Impreg = False And OpBt_LamBP = False And OpBt_LamFF = False And OpBt_MaDePan = False And OpBt_MaDeFibra = False And OpBt_ApaBoem = False And OpBt_DevCli = False Then
MsgBox ("Selecione uma Origem!")
Exit Sub
ElseIf OpBt_Almox = True Then
coluna = 1
ElseIf OpBt_Impreg = True Then
coluna = 2
ElseIf OpBt_LamBP = True Then
coluna = 3
ElseIf OpBt_LamFF = True Then
coluna = 4
ElseIf OpBt_MaDePan = True Then
coluna = 5
ElseIf OpBt_MaDeFibra = True Then
coluna = 6
ElseIf OpBt_ApaBoem = True Then
coluna = 7
Else
coluna = 8
End If
'Nomeia os botões de opção no formulário
If coluna = 1 Then
DescOrigem = "Almoxarifado"
ElseIf coluna = 2 Then
DescOrigem = "Impregnadora"
ElseIf coluna = 3 Then
DescOrigem = "Laminção BP"
ElseIf coluna = 4 Then
DescOrigem = "Laminação FF"
ElseIf coluna = 5 Then
DescOrigem = "MaDePan"
ElseIf coluna = 6 Then
DescOrigem = "MaDeFibra"
ElseIf coluna = 7 Then
DescOrigem = "ApaBoem"
ElseIf coluna = 8 Then
DescOrigem = "Devolução Cliente"
End If
Dim RData
Dim RMes
Dim ROrg
Dim VDia
Dim Dia
Dim Hora
vMes = Month(CDate(Now))
RData = Format(Date, "yy")
RMes = Format(Date, "mm")
Dia = Date
Hora = Time
ROrg = coluna
FrmLancNc.txt_Origem = DescOrigem
Linha = 2
cont = 1
cont = cont + WorksheetFunction.CountIf(Range("L:L"), vMes)
FrmLancNc.txt_Contator.Text = RMes
If cont > 9 Then
zero = ""
Else
zero = "0"
End If
FrmLancNc.txt_Numero.Text = RData & "" & RMes & "" & ROrg & "" & zero & cont
FrmLancNc.txt_Data.Text = Dia & " - " & Hora
FrmLancNc.txt_DataOcorrencia.SetFocus
End Sub