Excel: Compare 2 columns and pull missing data into 3rd column - excel

Been searching like crazy but can't find exactly what I'm looking for.
Column A: Some employees (Partial List)
Column E: All employees (Complete List)
I need Column C to be populated with all other employees not in Column A (Column A compared to Column E to pull data into Column C that is not in Column A).
I have tried IF, VLOOKUP functions and have come close but don't want any blank cells in Column C.
I would prefer a VBA code (as column A and C are linked to an external datasource) and are populated using VBA.
Thanks in advance!

Try this:
Sub test()
Dim LastRowA As Long
Dim LastRowC As Long
Dim LastRowE As Long
Dim i As Long
Dim j As Long
Dim NameNotExist As Boolean
LastRowA =Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
LastRowC = Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row
LastRowE = Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row
For i = 1 To LastRowE
For j = 1 To LastRowA
NameNotExist = False
If Sheet1.Range("E" & i).Value =Sheet1.Range("A" & j).Value Then
Exit For
Else
NameNotExist = True
End If
Next j
If NameNotExist = True Then
If LastRowC = 1 And Sheet1.Range("C1").Value = "" Then
Sheet1.Range("C1").Value =Sheet1.Range("E" & i).Value
Else:
LastRowC =Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row
Sheet1.Range("C" & LastRowC + 1).Value = Sheet1.Range("E" & i).Value
End If
End If
Next i
End Sub

Related

VBA "Sum and merge" a dynamic range

I want to get a sum based on the criteria of the preceding column data. Suppose I have three columns say A, B and C. So, "A" columns have the Sr.no. let's say, "B" has the quantity and "C" have the total quantity. I am trying to sum the quantity in column "B" based on the Sr.no. in column "A" and paste it to column "C" (after merging that many cells) against the respective Sr.no. (Which we have in column "A"). Refer image attached Image.
Sub sum_on_condition()
Dim sum_criteria As Double
Dim lastrow As Long, x As Long
Dim l_array As Variant
Dim l_number As Long
lastrow = range("A" & Rows.Count).End(xlUp).Row
l_array = range("I2:I21").Value
counter = 1
While counter <= UBound(l_array)
l_number = l_array(counter, 1)
For x = 2 To lastrow
If range("e" & x).Value = l_number Then
sum_criteria = sum_criteria + range("f" & x).Value
End If
Next x
counter = counter + 1
Wend
Debug.Print sum_criteria
End Sub
I have written this code but what it does it sums the total value rather than the individual value. I am not able to figure out how I do this!
Here's another approach:
Sub SumAndMerge()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim firstItem As Long, lastItem As Long
Dim i As Long, j As Long
Dim c As Range, d As Range
Dim valueToFind As String
Dim total As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
'Get valueToFind
valueToFind = ws.Cells(i, 1).value
'Get range of cells with .Find : look up for first value and last value and get row number.
With ws.Range("A" & i & ":" & "A" & lastRow)
Set c = .Find(valueToFind, LookAt:=xlWhole)
firstItem = c.Row - 1
Set d = .Find(valueToFind, LookAt:=xlWhole, SearchDirection:=xlPrevious)
lastItem = d.Row
End With
'Get total
total = WorksheetFunction.Sum(ws.Range("B" & firstItem & ":" & "B" & lastItem))
'Assign total to first cell
ws.Range("C" & firstItem).value = total
'Merge cells
ws.Range("C" & firstItem & ":" & "C" & lastItem).Merge
'Go to lastItem to adapt the loop
i = lastItem
Next i
End Sub
Gives the following output:
Rather than using an array, this macro aims at using the Find function. In a loop, we find the first value and the last value. We extract row numbers and then we can assign the total and finally merge cells.
This code can be improved by replacing harcoded A, B and C. But this gives you an example.

VBA copy mutlipe rows that meet criteria to another sheet

I really don't understand much VBA, so be patient with me.
I have a list of people assigned to a specific flight (LEGID) and I want to copy those people (Worksheet pax) to a specific cell in another worksheet (temp - cell b15), but it doesn't work.
This data table is a query report from salesforce.
Sub pax()
Dim LastRow As Long
Dim i As Long, j As Long
Dim legid As String
Application.ScreenUpdating = False
legid = ThisWorkbook.Worksheets("setup").Range("SelReq").Value
Debug.Print legid
'Find the last used row in a Column: column A in this example
With Worksheets("pax")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
' MsgBox (LastRow)
'first row number where you need to paste values in temp'
With Worksheets("temp")
j = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
End With
For i = 1 To LastRow
With Worksheets("pax")
If .Cells(i, 1).Value = legid Then
.Rows(i).Copy Destination:=Worksheets("temp").Range("a" & j)
j = j + 1
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
If you are looking to just get the names copied over. You can use this; however you will need to update your sheet names and ranges if they are named ranges. This code looks at a specific cell for a value on Sheet3 then if that value matches a value from a range on Sheet1 it will place the values from Column B on Sheet1 into Sheet2
Sub Test()
Dim cell As Range
Dim LastRow As Long, i As Long, j As Long
Dim legid As String
With Sheet1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Sheet2
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
legid = Sheet3.Range("A1")
For i = 2 To LastRow
For Each cell In Sheet1.Range("A" & i)
If cell.Value = legid Then
Sheet2.Range("A" & j) = cell.Offset(0, 1).Value
j = j + 1
End If
Next cell
Next i
End Sub

Displaying merged cell data in a For loop

I'm trying to display the contents of a merged cell in a For loop in Excel using VBA.
I have the a worksheet with very simple data in it
Here is my code:
'finding last record in my initial list
sheet_last_row = Sheets("mylist").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To sheet_last_row
last_row = Sheets("results").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("mylist").Cells(i, 1).Value = 2 Then
'test if cell is merged
If Sheets("mylist").Cells(i, 2).MergeCells Then
RowCount = Sheets("mylist").Cells(i, 2).Value
End If
Sheets("mylist").Cells(i, 1).EntireRow.Copy Sheets("results").Cells(last_row + 1, 1)
End If
Next i
I'm getting the following result with this code;
I'm new at this. Can anyone show me how to make this work.
You could try:
Option Explicit
Sub test()
Dim LastRowA As Long, LastRowB, LastRowC As Long, LastRowE As Long, MaxRow As Long
Dim cell As Range, rng As Range
With ThisWorkbook.Worksheets("Sheet1")
'Find the lastrow for all the available columns
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
'Get the longer last row in order to avoid losing data if the last cell of a column is merge or empty
MaxRow = WorksheetFunction.Max(LastRowA, LastRowB, LastRowC)
'Set the area to loop
Set rng = .Range("A2:C" & MaxRow)
'Start looping
For Each cell In rng
'If the cell is merger
If cell.MergeCells Then
'Find the last row of column E
LastRowE = .Cells(.Rows.Count, "E").End(xlUp).Row
'Paste cell value in column E
.Range("E" & LastRowE + 1).Value = cell.Value
'Paste cell address in column F
.Range("F" & LastRowE + 1).Value = cell.Address
End If
Next
End With
End Sub
Results:

Enter value in cell based on number from another cell

If anyone has done anything like below please help.
What I'm looking for is macro that looks at my A2 value and copy that in column D based on value B with "_"(underscore) after it.
You would need 2 loops for this. One looping through column A and one counting up to the value in column B.
Option Explicit
Public Sub WriteValues()
With Worksheets("Sheet1")
Dim aLastRow As Long
aLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get last used row in col A
Dim dRow As Long
dRow = 1 'start row in col D
Dim aRow As Long
For aRow = 1 To aLastRow 'loop through col A
Dim bCount As Long
For bCount = 1 To .Cells(aRow, "B").Value 'how many times is A repeated?
.Cells(dRow, "D").Value = .Cells(aRow, "A") & "_" & bCount 'write into column D
dRow = dRow + 1 'count rows up in col D
Next bCount
Next aRow
End With
End Sub
Your request is little short on particulars but this will do what you're asking.
dim i as long
with worksheets("sheet1")
for i=1 to .cells(2, "B").value2
.cells(.rows.count, "D").end(xlup).offset(1, 0) = .cells(2, "A").value & format(i, "\_0")
next i
end with

EXCEL VBA: match part of a string

i'm working on a Excel VBA Macro that can match the same entries in column V with the entries in column Y. Everything works fine but there some entries that just match a part of the other entry.
Example:
Column V: Column Y:
Word Excel
Word, Excel
Excel
Now for this example it will only mark the last entry, but it should also mark the secound entry.
Here's the code that i actually have now:
Sub MatchAndColor()
Dim lastRow As Long
Dim sheetName As String
sheetName = "MAIN" 'Name of the Sheet
lastRow = Sheets(sheetName).Range("V" & Rows.Count).End(xlUp).Row
lastRowB = Sheets(sheetName).Range("Y" & Rows.Count).End(xlUp).Row
For lrow = 2 To lastRow 'Loop through all rows
For lrowb = 2 To lastRowB 'Loop through all rows
If Sheets(sheetName).Cells(lrow, "V") Like Sheets(sheetName).Cells(lrowb, "Y") Then
Sheets(sheetName).Cells(lrow, "V").Interior.ColorIndex = 37 'Set Color to Light Blue
End If
Next lrowb
Next lrow
End Sub
Thank you for your help!
EDIT
Updated answer to match question update, this works with given example.
Sub MatchAndColor()
Dim lastRow As Long
Dim sheetName As String
sheetName = "MAIN" 'Name of the Sheet
lastRow = Sheets(sheetName).Range("V" & Rows.Count).End(xlUp).Row
lastRowB = Sheets(sheetName).Range("Y" & Rows.Count).End(xlUp).Row
For lrow = 2 To lastRow 'Loop through all rows
For lrowb = 2 To lastRowB 'Loop through all rows
If (Sheets(sheetName).Cells(lrow, "V") Like "*" & Sheets(sheetName).Cells(lrowb, "Y") & "*") Or (Sheets(sheetName).Cells(lrow, "Y") Like "*" & Sheets(sheetName).Cells(lrowb, "V") & "*") Then
Sheets(sheetName).Cells(lrow, "V").Interior.ColorIndex = 37 'Set Color to Light Blue
End If
Next lrowb
Next lrow
End Sub

Resources