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

August 2017




Issue


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 
Loop 

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$.

Solution


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


Published by aakai1056. Latest update on October 13, 2011 at 11:30 AM by aakai1056.
This document, titled "Excel - A macro copy to cell based on a specific criteria ," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).