Create unique ID when name not found on master

aroig07

New Member
Joined
Feb 26, 2019
Messages
35
Hi ! I am relatively new to coding in VBA and started building a program in which I want to go through a Worksheet and basically concatenate the values of 2 columns (A and D) and the value of column S depending on its value. After this is created I want to check in another worksheet if this unique value already exists, and if it does not add the row of information with its unique name.

Let me use my example so you better understand what I am trying to accomplish. I have one worksheet names RecurrentJobs which has the JobNames (column A), Account #'s (column D), and frequency per job (ex. daily, weekly, monthly...) (column S). The other columns have information but I do not need them at the moment. I want my macro to concatenate the JobNames + Account #, and loop through the frequency and perform a formula dependent on the value.

After this is performed I want to check these names with the names in column A on my other worksheet called MasterJobs. If the name already exists then nothing happens, but if the name does not exist then I want to add it to the list and copy information from entire row to the worksheet.

Here is what I have until now for the creation of the unique names (concatenate):

Sub FreqCalc()
'macro to loop through the recurrent jobs and create new jobs on master job trail based on their specified frequency
Dim RecurrentJobTrail As Worksheet
Dim NameRange As Long
Dim Frequency As Range
Dim SubAccount As Range
Dim CompleteUniqueName As String


Set RecurrentJobTrail = Worksheets("Recurrent Job Trail")
Set SubAccount = RecurrentJobTrail.Range("D2:D15000")
Set Frequency = RecurrentJobTrail.Range("S2:S15000")
Set NameRange = RecurrentJobTrail.Cells(Rows.Count, 1).End(xlUp).Row


'Check the recurrent jobs list to create unique values depending on their specified frequency
For Each RecJobCell In NameRange
CompleteUniqueName = RecJobCell & "-" & SubAccount & "-"
'frecuencia diaria
If Frequency = "Diario" Then
CompleteUniqueName = CompleteUniqueName & Format(Now(), "dd/mmm/yyyy")

'frecuencia semanal
ElseIf Frequency = "Semanal" Then
CompleteUniqueName = CompleteUniqueName & "Week of " & (Date - Weekday(Date, vbMonday) + 1)

'frecuencia mensual
ElseIf Frequency = "Mensual" Then
CompleteUniqueName = CompleteUniqueName & Format(Now(), "mmm/yyyy")

'frecuencia trimestral
ElseIf Frequency = "Trimestral" Then
CompleteUniqueName = CompleteUniqueName & "Trimester starting " & Format(Now(), "yyyy")

'frecuencia anual
ElseIf Frequency = "Anual" Then
CompleteUniqueName = CompleteUniqueName & Format(Now(), "yyyy")
End If


Next RecJobCell


End Sub
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,134
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
Code:
Sub aroig07()
   Dim Cl As Range
   Dim Nme As String
   Dim Dic As Object
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Recurrent Job Trail")
      For Each Cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         Nme = Cl.Value & "-" & Cl.Offset(, 3).Value & "-"
         Select Case Cl.Offset(, 18).Value
            Case "Diario"
               Nme = Nme & Format(Date, "dd/mmm/yyyy")
            Case "Semanal"
               Nme = Nme & "Week of " & (Date - Weekday(Date, vbMonday) + 1)
            Case "Mensual"
               Nme = Nme & Format(Date, "mmm/yyyy")
            Case "Trimestral"
               Nme = Nme & "Trimester starting " & Format(Date, "yyyy")
            Case "Anual"
               Nme = Nme & Format(Date, "yyyy")
         End Select
         Set Dic(Nme) = Cl
      Next Cl
   End With
   With Sheets("MasterJobs")
      For Each Cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Dic.Remove Cl.Value
      Next Cl
      For Each Ky In Dic.Keys
         Dic(Ky).EntireRow.Copy .Range("A" & Rows.count).End(xlUp).Offset(1)
      Next Ky
   End With
End Sub
 

aroig07

New Member
Joined
Feb 26, 2019
Messages
35
Hi ! Thank you so much for the quick response, this works better than what I had before that did not come up with anything. Only thing is that I want the name to be pasted as the concatenated version which would show up in the Master Jobs worksheet as JobName & Account# & Date (depending on the frequency on the select statements), that way if I run again and the job is daily it would see the previous days entry of the name but not a duplicate since it would have the next days date.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,134
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub aroig07()
   Dim cl As Range
   Dim Nme As String
   Dim Dic As Object
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Recurrent Job Trail")
      For Each cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         Nme = cl.Value & "-" & cl.Offset(, 3).Value & "-"
         Select Case cl.Offset(, 18).Value
            Case "Diario"
               Nme = Nme & Format(Date, "dd/mmm/yyyy")
            Case "Semanal"
               Nme = Nme & "Week of " & (Date - Weekday(Date, vbMonday) + 1)
            Case "Mensual"
               Nme = Nme & Format(Date, "mmm/yyyy")
            Case "Trimestral"
               Nme = Nme & "Trimester starting " & Format(Date, "yyyy")
            Case "Anual"
               Nme = Nme & Format(Date, "yyyy")
         End Select
         Set Dic(Nme) = cl
      Next cl
   End With
   With Sheets("MasterJobs")
      For Each cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         If Dic.Exists(cl.Value) Then Dic.Remove cl.Value
      Next cl
      For Each Ky In Dic.Keys
         With .Range("A" & Rows.count).End(xlUp).Offset(1)
            .Value = Ky
            Dic(Ky).Resize(, [COLOR=#ff0000]20[/COLOR]).Copy .Offset(, 1)
         End With
      Next Ky
   End With
End Sub
Change the value in red to match the number of columns in you data.
 

aroig07

New Member
Joined
Feb 26, 2019
Messages
35

ADVERTISEMENT

That worked like a charm ! Thank you so much !
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,134
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

aroig07

New Member
Joined
Feb 26, 2019
Messages
35
Hi ! Noticed you have been helping me on another feed as well. Thanks so much for your help with everything. I just noticed on this code that when it copies, the formulas are all waked up. Is there a way to copy and paste the values without formulas ??? I tried the PasteSpecial after Copy, but had a debug.

Thanks again!!!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,134
Office Version
  1. 365
Platform
  1. Windows
To get values only change
Code:
Dic(Ky).Resize(, [COLOR=#ff0000]20[/COLOR]).Copy .Offset(, 1)
to
Code:
Dic(Ky).Resize(, [COLOR=#ff0000]20[/COLOR]).Copy 
.Offset(, 1).PasteSpecial xlPasteValues
 

Watch MrExcel Video

Forum statistics

Threads
1,108,709
Messages
5,524,433
Members
409,577
Latest member
Dwg

This Week's Hot Topics

Top