Add missing data from list

[AshAlom]

Hi

Trying to find a simple solution to this problem,

I have a table of data with only columns A,B & C, all columns have data that go on for ever. Column B should always have the same data in the same order.
The problem is some data from column B is missing and I would like to know if I can auto populate these (macro) with the missing data from an existing list but when adding data I need the whole row to be dropped instead of just column B and also add the value 0 in column C next to it.

I'm not sure if I've explained the issue clearly so here's a table to demonstrate this better:

Row 5 has 'Alpha' missing i'd like to add that with a 0 value as well in column C
same for after row 9 where 'Bravo' is missing.

	A	B	C
1	Any	Alpha	1
2	Any	Bravo	4
3	Any	Charlie	54
4	Any	Delta	52
5	Any	Bravo	7
6	Any	Charlie	4
7	Any	Delta	8
8	Any	Alpha	258
9	Any	Charlie	2

<tbody>
</tbody>

Existing List

Alpha

Bravo

Charlie

Delta

<tbody>
</tbody>

I hope there's a solution out there for this, Thank you.

AA

 

[Nine Zero]

Hello.... try this out... tested and works on my end

Sub Stuff()
    Dim r As Range
    For Each r In Range("B1:B10") 'change the 10 here to however may rows of data you have
        If r.Value = "Alpha" Then
            If Not r.Offset(1, 0).Value = "Bravo" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = "Any"
                Range("B" & r.Offset(1, 0).Row).Value = "Bravo"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        ElseIf r.Value = "Bravo" Then
            If Not r.Offset(1, 0).Value = "Charlie" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = "Any"
                Range("B" & r.Offset(1, 0).Row).Value = "Charlie"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        ElseIf r.Value = "Charlie" Then
            If Not r.Offset(1, 0).Value = "Delta" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = "Any"
                Range("B" & r.Offset(1, 0).Row).Value = "Delta"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        ElseIf r.Value = "Delta" Then
            If Not r.Offset(1, 0).Value = "Alpha" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = "Any"
                Range("B" & r.Offset(1, 0).Row).Value = "Alpha"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        End If
    Next r
End Sub

 

[AshAlom]

Hi Zero Nine

Thanks for posting this solution, will be testing it now.

How can i remove the 'Any' and leave this section blank?

 

[Nine Zero]

If you want the new rows to just have a blank instead of the word any change the red text to ""

Sub Stuff()
    Dim r As Range
    For Each r In Range("B1:B10") 'change the 10 here to however may rows of data you have
        If r.Value = "Alpha" Then
            If Not r.Offset(1, 0).Value = "Bravo" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = [B][COLOR=#ff0000]"Any"[/COLOR][/B]
                Range("B " & r.Offset(1, 0).Row).Value = "Bravo"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        ElseIf r.Value = "Bravo" Then
            If Not r.Offset(1, 0).Value = "Charlie" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = [COLOR=#ff0000][B]"Any"[/B][/COLOR]
                Range("B" & r.Offset(1, 0).Row).Value = "Charlie"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        ElseIf r.Value = "Charlie" Then
            If Not r.Offset(1, 0).Value = "Delta" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r .Offset(1, 0).Row).Value = [COLOR=#ff0000][B]"Any"[/B][/COLOR]
                Range("B" & r.Offset(1, 0).Row).Value = "Delta"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        ElseIf r.Value = "Delta" Then
            If Not r.Offset(1, 0).Value = "Alpha" Then
                Rows(r.Offset(1, 0).Row & ":" & r.Offset(1, 0).Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A" & r.Offset(1, 0).Row).Value = [COLOR=#ff0000][B]"Any"[/B][/COLOR]
                Range("B" & r.Offset(1, 0).Row).Value = "Alpha"
                Range("C" & r.Offset(1, 0).Row).Value = "0"
            End If
        End If
    Next r
End Sub

 

[AshAlom]

i'm getting run-time error '1004
method 'range' of object_Global failed

i changed the 'any' to blank and changed the cell range to 900 (my test sheet has 829 rows)

 

[AshAlom]

now im getting run-time error 13
Type mismatch

on this row
If Not r.Offset(1, 0).Value = "Alpha" Then

 

[AshAlom]

Hi

This isn't really working properly for me, I end up with loads of extra rows being created.
I think its because in column B I have some data that only has one of the 4 values and some have 2 etc from my existing list and in other rows there are no values at all, but all the values from the existing list need to be added.
Hope that makes sense.