I have a Macro, it basically allocates Person and Grade Level to Classes in a new worksheet. It then makes bold any instance where a person is not in HC data. That is not that important, it is all functioning well. In my code, I highlighted, in bold, the area I need help on. This is where I figure out if the data is missing and then make it bold. Instead of making it bold I was wondering if it was possible, to try to allocate the data based off the last 4 digits of the person, but with the first 3 being 011. In my sample workbook, I am missing HC data for 015 5858, I would then like to see if there is HC data for 011 5858 and then copy that data within the HC sheet (but replacing the Person as 015 5858). In my workbook I included a HC sheet and a HC After... the HC after is what I would like the end result to be.
There is always 3 spaces in between the left numbers and the right numbers and they are stored as text. I am basically looking for something that will, within that IF statement I bolded, Find "011 " & RIGHT(cname,4) in HC, and copy all instances below the last row but replaced cname for the person (in this example 015 5858).
Option Explicit
Public Sub TitleAllocation()
'Clear End Result
Sheets("End Result").Cells.Clear
'Do not show me what is happening until everything is over [helps speed]
Application.ScreenUpdating = False
'Defining Variables
Dim LR As Long
Dim LR1 As Long
Dim LR2 As Long
Dim Rng As Range
Dim Rng1 As Range
Dim cName As Range
Dim cName1 As Range
Dim ctr As Long
'Set LR as The amount of rows in Data
LR = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row
'Set LR1 as the amount of rows in HC
LR1 = Sheets("HC").Range("B" & Rows.Count).End(xlUp).Row
'Set Rng as all information in Range B in Data
Set Rng = Sheets("Data").Range("B2:B" & LR)
'Set Rng1 as all information in Range A in HC
Set Rng1 = Sheets("HC").Range("A2:A" & LR1)
'Takes away all Bold rows in Data to get rid of old 'errors'
For Each cName In Rng
cName.EntireRow.Font.Bold = False
Next cName
'For every row in column B in Data, Find matches in column A in HC, and with the matches you find: Copy the corresponding column A &B in Data [Grade Level and Person] to columns A&B of the next empty row in End Result,
' ------>>>> And then Copy the Class in column B of HC to column C of End Result
For Each cName In Rng
For Each cName1 In Rng1
If cName = cName1 Then
'Set LR2 as last row in End Result
LR2 = Sheets("End Result").Range("B" & Rows.Count).End(xlUp).Row
Sheets("End Result").Range("A" & LR2 + 1 & ":" & "B" & LR2 + 1) = cName.Offset(0, -1).Resize(1, 2).Value
Sheets("End Result").Range("C" & LR2 + 1) = cName1.Offset(0, 1).Value
End If
Next cName1
Next cName
'This next section will make any row that is missing HC data BOLD in Data
LR2 = Sheets("End Result").Range("B" & Rows.Count).End(xlUp).Row
For Each cName In Rng
If Application.CountIf(Sheets("End Result").Range("B2:B" & LR2), cName) = 0 Then
cName.EntireRow.Font.Bold = True
End If
Next cName
'Update the screen with the new data
Application.ScreenUpdating = True
End Sub
Edit:
I have the following code done, I think I may just need help with my Copy/Paste coding
For Each cName In Rng
If Application.CountIf(Sheets("End Result").Range("B2:B" & LR2), cName) = 0 Then
cName.EntireRow.Font.Bold = True
For Each cName1 In Rng1
If cName1 = "011 " & Right(cName, 4) Then
LR1 = Sheets("HC").Range("B" & Rows.Count).End(xlUp).Row
cName1.EntireRow.Copy
Sheets("HC").Range("A" & LR1 + 1).EntireRow.Paste
Sheets("HC").Range("A" & LR1 + 1) = cName
End If
Next
End If
Next cName
LR2 = Sheets("End Result").Range("B" & Rows.Count).End(xlUp).Row
For Each cName In Rng
If Application.CountIf(Sheets("End Result").Range("B2:B" & LR2), cName) = 0 Then
cName.EntireRow.Font.Bold = True
For Each cName1 In Rng1
If cName1 = "011 " & Right(cName, 4) Then
LR1 = Sheets("HC").Range("A" & Rows.Count).End(xlUp).Row
Sheets("HC").Range("A" & LR1 + 1 & ":Z" & LR1 + 1) = cName1.Resize(1, 26).Value
Sheets("HC").Range("A" & LR1 + 1) = cName
End If
Next
End If
Next cName
Woooh
Bookmarks