I have three columns, A, B and C:
Column A contains names, NAME1, NAME2, etc.
Column B contains only the values "YES" or "NO".
Column C is suppose to contain the names from column A that have value "YES" in column B.
I can say that as long as the value is "YES" in column B, copy the value from column A to column C. Very simple with:
C1=IF(B1="YES",A1,"")
But this will include blank cells, which I don't want to. So I guess I am looking for a way to copy all the names from column A with value "YES" in column B and paste them into column C skipping the blanks.
I did find a VBA project that colors all the cells within a column with a certain value. I am not sure how to edit this into what I need. Here is the code I came up with so far.
ISSUES
1) Runtime Error '1004' Application-defined or Object-defined error
2) Copying from Column A
3) Check and Remove Duplicates from NewRange
EDIT 1: Added comment rows into the code
EDIT 2: Change NewRange to be made from column A with Offset (untested due to runtime error)
EDIT 3: Code for copying form one sheet separated from code for pasting into another sheet
EDIT 4: Added correction from user #abahgat
EDIT 5: Remove duplicates
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
'--> Loop through each cell in column B
'--> Add each cell in column A with value "YES" in column B to NewRange
For Each cell In Worksheets("Sheet1").Range("B1:B30")
If cell.Value = "YES" Then
If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
MyCount = MyCount + 1
End If
Next cell
'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=activesheet.Range("C1")
'--> Remove Duplicates
activesheet.Range("C1:C30").RemoveDuplicates
End Sub
Solution without VBA:
column C contains formulas like:
=COUNTIF(B$1:B1;"yes")
increase number in column C if this row has "yes" value in column B.
This value will by used in next step.
column D contains formulas like:
=INDEX(A:A;MATCH(ROW();C:C;0))
take value from:
table: an entire A row
row number: calculated by match function: find first occurance of row number (row number where we will place the value) in entire C column. 0 meens that we looking for exactly this number not an clossest.
to skip errors:
=IF(ISERROR(MATCH(ROW();C:C;0));"";INDEX(A:A;MATCH(ROW();C:C;0)))
easier can be writen:
=IFERROR(INDEX(A:A;MATCH(ROW();C:C;0));"")
and this means:
write the value from rule if this value is not an error or write empty string if the rule is an error
Just used a Andcondition on your If to avoid the empty cells
In C1, put then copy down =IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
Select column C
Press F5
Special ... check Formulas and then tick Errors (see pic)
Delete the selected cells, to leave you with a shorter list of desired names in column C
This will do the trick:
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
For Each cell In Worksheets("Sheet1").Range("B1:B30")
If cell.Value = "YES" Then
If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
MyCount = MyCount + 1
End If
Next cell
NewRange.Copy Destination:=activesheet.Range("D1")
End Sub
Related
Consider the following table:
I have a series of blank cells with missing data. From this missing data I only have the year in the next column. I need to fill any blank cells with a standard day/month of 30/06. The year of each cell however needs to be the year in the next column. The attached file shows how my data is arranged. So at cell B 2091, the date shall be 30/06/2011 while for cell B 2098 the date shall be 30/06/2018 and at cell B 2100 the date shall be 30/06/2008.
Filter on the blank cells in column B. Then, in the topmost cell (which I'll assume to be B1 but will likely be different), enter a formula similar to the following and fill down
=DATE(C1,6,30)
where the row number in C1 is the same as your first row of data.
You can achieve this with a helper column (any blank column in the same worksheet where you need the dates). In that column enter this formula in the first cell (here in row 2) and copy down.
=IF(ISBLANK(B2),DATE(C2,6,30),B2)
Then copy the Values from the helper column to the date column and delete the helper.
Below is a small macro that is doing the same job. It needs no helper column and over-writes your existing blanks. Before you run it make sure to check the values of the 2 constants at the top and the name of the worksheet (especially the latter!) against your requirements.
Sub WriteStandardDate()
'293
Const FirstDataRow As Long = 2 'change to suit
Const DateClm As Long = 2 'change to suit
' year column must be adjacent to DateClm
Dim R As Long
Dim Arr As Variant
Dim Rng As Range
With Worksheets("Sheet1") ' change name as required
Set Rng = .Range(.Cells(FirstDataRow, DateClm), _
.Cells(.Rows.Count, DateClm).End(xlUp)) _
.Resize(, 2)
Arr = Rng.Value
For R = 1 To UBound(Arr)
If IsEmpty(Arr(R, 1)) Then
Arr(R, 1) = DateSerial(Arr(R, 2), 6, 30)
End If
Next R
Rng.Value = Arr
End With
End Sub
Update: I used the formula suggested by Variatus: =IF(ISBLANK(B2),DATE(C2,6,30),B2) and worked fine through a helper column. There was no need to copy / paste the new dates into the Dates column. I just used the helper column as the new Dates column since full dates from the original column were not changed and got inserted in the helper column thanks to the IFBLANK portion of the formula. Thanks.
I need to go through a table (X by Y) where every column (X) should have the same value (string) and would like the cell to get highlighted if is not the same value. I'm stuck in building the comparison method, because I would like it to be dynamic. I would like to first determine what is the value that is present the most in the column and determine that is what everything else needs to be compared against and highlight the cell that is not equal to this value.
Example (6x5 table) -
A 3 4 C M R
A 3 4 O M R
8 3 T O M F
8 3 4 O M G
A 3 T O Y K
In the first column, A is the most prevalent value therefore the (8s) are highlighted, second column nothing is highlighted, third both (T) are highlighted, fourth column (C), fifth column (Y) and sixth column (F),(G) and (K) are highlighted.
Thank you in advance.
I can suggest a workaround. Not sure if this is the best way though.
Step 1. Create a count if table which basically gives you the count of a value in the column. Ex: for cell F4 use formula =COUNTIF($B$4:$B$8,B4)
Step 2. Create a row with max values of each column. Ex: Cell F11 =MAX(F4:F8)
Step 3. For each cell, give a conditional formatting condition that if the value in the count table does not match the max value, color it. Ex: for cell B4, go to conditional formatting -> new rule -> use a formula and write this formula =F4<>F$11. Then copy paste the format to all other cells.
Note: this will not work when multiple values in a column have the same max count.
Here is a VBA solution, I've commented the code so you can understand
Sub HighlightNonFrequentInColumn()
Dim rng As Range
Dim col As Range
Dim cell As Range
Dim myVal As String
Dim colRng As String
Set rng = Selection '<<change range as required
For Each col In rng.Columns
'determine the most frequent value
colRng = col.Address
On Error Resume Next
myVal = Application.Evaluate("INDEX(" & colRng & ",MODE(IF(" & colRng & "<>"""",MATCH(" & colRng & "," & colRng & ",0))))")
If Application.countblanks(col) > Application.CountIf(col, myVal) Then myVal = "" '<<if blanks are most frequent
'highlight all cells not equals to most frequent value
For Each cell In col.Cells
If Not cell = myVal Then cell.Interior.Color = vbYellow '<<change colour as desired
Next
Next
End Sub
I am new to VBA Excel and wondering if you can help.
I have tried typing something similar to this =IF(C10,(ROW(A10)-ROW(A$9)),"") and it works. However, the downside to this is you have to enter this formula into every cell that you want to auto populate. I am trying to find a macro code in Excel so that cells will auto number 1,2,3,etc. whenever the adjacent column contains data?
For example, when a user enters data into B1, A1 will automatically be populated to 1. Then when users enters data into B2, A2 will automatically be populated to 2 and so on. Then when users delete data from B column, adjacent column in A will not contain a number.
Enter this into A1 based on what you said:
=if(isblank(B1),"",row())
If you want this in VBA you can use the following, but this assumes your data starts at Row 1. If it you want the numbering at Row 2 to start as 1, just add "-1" after the RngA part.
Sub Serial()
Dim RngA As Long, LastRow as Long 'Declares the variables used
LastRow = ActiveSheet.Cells(Cells.Rows.Count, "B").End(xlUp).Row 'This finds the last row in Column B where the loop will end.
For RngA = 1 To LastRow ' This loops from the first row to the last cell filled in column B
If Cells(RngA, 2) <> "" Then ' If Column B is blank, skip this row
Cells(RngA, 1).Value = RngA 'Column B was not blank, so put the row number in column A
End If
Next
End Sub
Column A is inventory that I should have. Column B is inventory I received.
I am missing a lot of inventory and have had to manually do this. What I want is the numbers in each column to match up & the numbers that are not present in B that are present in A to add a space in column B to show thats it's missing:
What I have:
What I want:
This is a pretty lightweight VBA routine that will do what you need:
Sub matchCells()
Dim colARange As Range
Dim colACell As Range
'Change this to your Column A range size
Set colARange = Sheet1.Range("A1:A5000")
'Iterate through each cell in your Column A Range
For Each colACell In colARange.Cells
'Check if the cell in Column A doesn't match the cell in Column B
If Not (colACell.Value = colACell.Offset(0, 1).Value) Then
'It doesn't match so shift Column B's cell down one
colACell.Offset(0, 1).Insert Shift:=xlShiftDown
End If
'Now we loop again and we will continue shifting Column B down
' a cell until it matches.
Next
End Sub
You can try below formula on Column C... Should give you the result you need in Column C.
=IF(ISNA(VLOOKUP(A1,$B$1:$B$10,1,FALSE)),"",VLOOKUP(A1,$B$1:$B$10,1,FALSE))
$B$1:$B$10 is the Range of data (no of rows in column B)
This site already has something similar: Copy and insert rows based off of values in a column
but the code doesn't take me quite where I need to go, and I haven't been able to tweak it to make it work for me.
My user has a worksheet with 4 columns, A-D. Column A contains specific contract numbers, column B is blank, column C has part numbers, and column D has the entire range of contract numbers. My user wants to count the number of times the entire range contract numbers has duplicates so I entered the formula =countif($D$2:$D$100000,A2) in cell E2 and copied down, giving me the number of times the specific contract in column A appears in column D. The numbers range from 1 to 11 in this workbook but the number may be higher in other workbooks this method will be used in.
The next thing I need to do is to enter blank cells below all values in column E that are greater than 1, very much like the example in the previously asked question. I then also need to copy in the same row and insert copied cells exactly to match in the same row in column A. Example: Cell E21 has the number 5 so I need to shift cells in column E only so that there are 4 blanks cells directly below it. In column A, I need to copy cell A21 and insert copied cells in four rows directly below.
Just trying to get the blank cells to insert has been a trial, using the code as given in the previous question.
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet
Set lo = sh.ListObjects("Count")
Set rColumn = lo.ListColumns("Count").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).Cells.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
I would be very grateful for any help as I have been fighting with this monster for a week.
While this is indeed possible to do, it might be a good idea to look into moving the list of all contract numbers from column D to a different sheet. Even though it is quite simple to loop through a range and insert rows based on cell values - it'll also create holes in columns D and E.
Here's code for simply adding the rows and copying the values as you specified.
Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("E" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
source.Range("A" & i + 1) = val 'Set value
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub
Of course you could also remove the holes from column D after inserting the new rows and modify the formula in column E so that it remains copyable and doesn't calculate for the copied rows.
Generally it makes things easier if a single row can be thought of as a single object, as creating or deleting a row only affects that one single object. Here we have one row represent both a specific contract and a contract in the all contracts list - this could end up causing trouble later on (or it could be totally fine!)