Excel - A macro copy to cell based on a specific criteria

October 2016


I'm stuck. I hope someone can help me out today. I have an excel spreadsheet with 1400 rows. The first 3 rows are irrelevant (headings). I have 3 cells with $tring content (B:C:D). What I need to do is create a macro that can specifically look in column B and column D for non-null values. There are multiple cells in this spreadsheet that must have the same value. Column B and D must be compared, and must be found with non-null values. And, in the same instance where Column B is also found again (loop) (same cell content, but different row) Col D will have a null value (missing content). I need to fill this Col D with the same content as the first record that had Col B and D content. In my example the value is hard coded, I don't know how else to do it. I'm very lost and I need some help to complete this. This is what I have.

Sub _MacroUser10() 

Set I = Worksheets("Sheet2") 
Dim d 
Dim j 

d = 1 'loop counter 
j = 4 'start at the 4th row because of headings 

Do Until ActiveCell(I.Range("B" & j) = "User Portfolio Group") And ActiveCell(I.Range("D" & j <> null)) 'loop 

If I.Range("B" & j) = "User2010" Then 'the cell is entitled User2010...etc 
If I.Range("D" & j) = " " Then 'this is supposed to find the null values in D 
d = d + 1 
End If 
i.Rows(d).Value = I.Rows(j).Value 
End If 
j = j + 1 

End Sub 

All in all. I need to lookup the content in Cell B$ and lookup the content in Cell D$. There will be one row with content in both places. Then I need to find all the other matching rows that match B$ that do not have any values in D$. I need to add those missing values from the non-null D$ to the null D$.


If the case is always that the filled row will occur before blank one , then you can use dictionary object. For that
  • Loop through your first row till the end
  • If both cells are not empty, combine the value of B and D as key and value of C as value .
  • As you go through rows, first check if that key is in the dictionary, if yes, you have the value else add to the dictionary

' to create dic object 
Set dicMyDic = CreateObect("Scripting.Dictionary") 

'this is how key can be 
strKey = B1 & "|" & D1 

'check if value of D is blank or not 

' to add the value to dic 
IF Not (dicMyDic.Exists(strKey )) then dicMyDic.Add Key:=strKey, Item:=val 

'to get the value from dic 
IF (dicMyDic.Exists(strKey )) then val = dicMyDic(strKey) 

Thanks to rizvisa1 for this tip.

Related :

This document entitled « Excel - A macro copy to cell based on a specific criteria  » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.