Solved: insert row if match is missing in column above

[mperrah]

Hello VBAExpress,

I have a column "G" with 2 sections of data and rows that are associated. with a header row. in the first column "A" is an item number
typically row 2 to 19 has HAR, row 20 to 39 has HAR-QC,
but the actual number of rows of HAR can change.
I have a macro that sorts the data to this stage every morning.
I insert a formula in the top section that pulls numbers from the bottom,
but if the values don't match the formula throws an error.

I'm looking for a way to count the occurrences of HAR down from row 2 till it ends, then look at the occurence of HAR-QC and add the missing items numbers in the same number row down that it would be in the HAR section.

I have this so far to count the occurrences, but not sure how to implement the look for a macth of the item number and insert if not present
[VBA]
Sub countHAR()
Dim i As Integer
Dim cHAR As Integer
i = 0
cHAR = 0
For i = 2 To 50
If Cells(i, 7).Value = "HAR" Then
cHAR = cHAR + 1
End If
Next i
'MsgBox Str(cHAR) & " HAR rows"
End Sub

Sub countHARQC()
Dim i As Integer
Dim cHARQC As Integer
i = 0
cHARQC = 0
For i = 2 To 50
If Cells(i, 7).Value = "HAR-QC" Then
cHARQC = cHARQC + 1
End If
Next i
'MsgBox Str(cHARQC) & " HAR-QC rows"
End Sub
[/VBA]
attached is the file im working on so far.

I 'll attach a sample of the raw data next.

Thank you in advance.
mp

[mperrah]

here is the raw data I'm starting with.
The macro runs fine on this test sample,
but if they add a new item in the HAR section,
or the HAR-QC item is missing a match from the HAR section
the output is thrown off.

thanks for your time.

[Bob Phillips]

I keep getting errors.It errored on opening on an Application.Goto, then on the import it errored on a Sort.

[snb]

[VBA]
Sub count_snb()
MsgBox [countif(sheet1!G1:G100,"HAR")]
MsgBox [countif(sheet1!G1:G100,"HAR-QC")]
End Sub

[/VBA]

[mperrah]

Try this Bob.
Thanks for the quick response.
- snb, how can i take the countif match to insert the missing rows?
how do I log the row reference down from A2 for the item found in the top section but missing in the lower section, and use that refence to insert that item the same number of rows down from where the second section starts?
in Column "G" is HAR for the upper section and HAR-QC for the lower section... but the amount of line items can vary, that's why I want to scan and update. The upper section can have more than the lower, never more in the lower than upper...



Looking at this image, A2 has D653-UQA
That same item is also in A20
but A4 has H33-UMA which is missing from A22
how can I insert a row with just the H33-UMA if its match is not found above.
End result is a list above that has different amounts of products each time,
and I need to add items to lower part of list so the same amount of products are in the lower part.
something like:
[VBA]
Sub countHAR()

Dim i As Integer
Dim x As integer
Dim cHAR As Integer
Dim cHARQC As Integer
i = 0
x = 0
cHARQC = 0
cHAR = 0

For i = 2 To 50
For x = 2 To 50
If Cells(i, 7).Value = "HAR" Then
cHAR = cHAR + 1
End If
If Cells(x, 7).Value = "HAR-QC" Then
cHARQC = cHARQC + 1
End If

' ***this is the part I need help***
' if value.A(i) <> value.A(x) then
' insertRow at A(x). shift xlDown
' A(x).Value = A(i) / in the newly inserted row
' End if
' *** not sure how to accomplish this ***

Next x
Next i
'

End Sub
[/VBA]
This is an attempt.
all help is much appreciated
mp

[mperrah]

Here is the data as I get it
I open my file, then on the Add-in Menu I run my macro and browse to this file and it completes the macro to update the data.
If the rows of data didnt change I can just do a Macro record and life goes on.
But if they create a new product (so upper list has more then the current 19 items), or the HAR-QC item is missing from the lower list (less then the current 19 items) my macro errors out.
So both sections need to match...
I really appreciate your patience and support.
mp

[mperrah]

oops, screen image didn't load above, here it is...

[mperrah]

[VBA]

Sub countHAR()
Dim i As Integer, x As Integer, y As Integer
Dim a01 As Integer
Dim HARcnt As Integer
Dim cHARQC As Integer
Dim str1 As String
Dim str2 As String


i = 0
x = 0
a01 = 0
cHARQC = 0

For i = 2 To 50 ' find number of HAR row items
If Cells(i, 7).Value = "HAR" Then
a01 = a01 + 1
End If
Next i

For x = 2 To 50 ' find if number of HAR-QC rows match HAR count - exit sub if yes
If Cells(x, 7).Value = "HAR-QC" Then
cHARQC = cHARQC + 1
End If
Next x

If a01 = cHARQC Then Exit Sub



For y = a01 To 50 ' use to start at HAR-QC row beginning

str1 = Cells(y, 2)
str2 = Cells(y - (a01 - 1), 2)

If str1 <> str2 Then

Rows(y).Offset(1, 0).Select
Selection.EntireRow.Insert xlDown
Cells(y, 2).Value = str1

End If

y = y + 1

Next y

End Sub

[/VBA]

[mperrah]

test 3, still kicking output wrong
[VBA]
Sub countHAR()
Dim i As Integer, x As Integer, y As Integer
Dim a01 As Integer
Dim HARcnt As Integer
Dim cHARQC As Integer
Dim str1 As String
Dim str2 As String


i = 0
x = 0
a01 = 0
cHARQC = 0

For i = 2 To 50 ' find number of HAR row items
If Cells(i, 7).Value = "HAR" Then
a01 = a01 + 1
End If
Next i

For x = 2 To 50 ' find if number of HAR-QC rows match HAR count - exit sub if yes
If Cells(x, 7).Value = "HAR-QC" Then
cHARQC = cHARQC + 1
End If
Next x

If a01 = cHARQC Then Exit Sub


' Trouble getting output right here down?
For y = a01 To 50 ' use to start at HAR-QC row beginning

str1 = Cells((y + 1) - a01, 2) ' the HAR product name
str2 = Cells(y, 2) ' the HAR-QC product name


If str1 <> str2 Then 'test if strings are identical

Rows(y).Offset(1, 0).Select 'insert entire row and shift down
Selection.EntireRow.Insert xlDown
Cells(y + 1, 2).Value = str1 ' add cell string value from HAR section

End If

y = y + 1

Next y

End Sub
[/VBA]

[mperrah]

thought I had it, but this doesn't work either , help please.
attached data I'm working with too

Thank You

[VBA]
Sub InsertRowAtChangeDif()

Dim lRow As Long
Dim i As Integer
Dim c As Integer
Dim d As Integer
Dim dif As Integer

c = 0
For i = 2 To 50 ' 50 is arbitrary but values are typically around 18-22
If Cells(i, 2).Value = "HAR" Then ' check for how many HAR items
c = c + 1
End If
Next i


d = 0
For i = 2 To 50
If Cells(i, 2).Value = "HAR-QC" Then ' check for how many HAR-QC items
d = d + 1
End If
Next i

dif = c

For lRow = Cells(c, "C").End(xlUp).Row To 2 Step -1 ' start from bottom and check up for mis-match

If Cells(lRow, "C") <> Cells(lRow - dif, "C") Then ' if items dont match then insert row
Rows(lRow).EntireRow.Insert
Cells(lRow, "C") = Cells(lRow - dif, "C").Value ' add contents to inserted row

End If

Next lRow

End Sub

[/VBA]

[mperrah]

I've been looking for other ways to solve finding the missing rows in order to insert a formula, when it dawned on me.
maybe just use a sheet change macro to add the values and bypass the formula all together

the formula im trying to paste scans the prod id in column "B" from row 2 till the end of the section with HAR in column "G"
(Column G Later gets deleted, only used for seperating the prod id by location)
then finds a match in a row lower also in column "B" usually 22 to 41 but not always,
then takes the value 5 columns to the right and adds it to the coinciding value in the upper match. result is in the formula cell.
the formula only works when the range has the same number of cells in both sections, this is what I've been trying to fix.

So, how can I just find a match, regardless of how far down, (example - C12 has H35-UQD and C32 has the match H35-UQD)
and add the resulting value of the cell 5 columns over to the matched cell offset ()?
4 columns over is the value to add, 5 columns over is where the result needs to be.
There will only ever be 1 match and some items will not have a match - and thats ok if this method can work
The calculation only needs to happen once, not ongoingly... like on load or on run sub()

I know Bob can knock this out of the Park.
Anxiously awaiting your input.
mp

[mperrah]

Still trying,
Hers another test at finding missing item in column and inserting.
I have a second sheet with same data to paste when code fails - often
Im not getting the timing right for finding the miss-match and where to insert and where to copy contents from and to.
to the right on the sheet is a sample of what it should look like when ran, and I highlighted cell that should get the insert...
Any takers?

Thanks in advance..
mp

[VBA]
Sub AddMissingItems()

Dim lRow As Long
Dim i As Integer
Dim c As Integer
Dim d As Integer
Dim x As Integer
Dim ttl As Long

c = 0
d = 0
x = 0

For i = 2 To 50 ' 50 is arbitrary but values are typically around 18-22
If Cells(i, 10).Value = "HAR" Then ' check for how many HAR items
c = c + 1
End If
Next i

For i = 2 To 50
If Cells(i, 10).Value = "HAR-QC" Then ' check for how many HAR-QC items
d = d + 1
End If
Next i

x = c + d ' total HAR and HAR-QC items found


For lRow = x To 2 Step -1 ' start from bottom and check up for mis-match

If Cells(lRow, 1) <> Cells(lRow + d, 1) Then ' if items dont match then insert row
Rows(lRow).EntireRow.Insert shift:=xlDown
Cells(lRow + d, 1) = Cells(lRow, 1) ' add contents to inserted row, left of = is source right is destination?

End If

Next lRow

End Sub
[/VBA]

[mperrah]

Got this to work.
There is probably a cleaner way, but yeah, I got it.
[VBA]
Sub AddtoHARQC()

Dim lRow As Long
Dim i As Integer
Dim c As Integer
Dim d As Integer

c = 0
d = 0

For i = 2 To 50 ' 50 is arbitrary but values are typically around 18-22
If Cells(i, 10).Value = "HAR" Then ' check for how many HAR items
c = c + 1
End If
Next i

For i = 2 To 50
If Cells(i, 10).Value = "HAR-QC" Then ' check for how many HAR-QC items
d = d + 1
End If
Next i

If c = d Then Exit Sub

For lRow = 2 To c + 1

If Cells(lRow, 1) <> Cells(lRow + c, 1) Then ' if items dont match then insert row
Rows(lRow + c).EntireRow.Insert shift:=xlDown
Cells(lRow + c, 1).Value = Cells(lRow, 1) ' add contents to inserted row, left of = is source right is destination
Cells(lRow + c, 6).Value = 0 ' add the zero value for the formula to work

lRow = lRow + 1 ' adjust the count of rows for the inserted one
End If

Next lRow

End Sub
[/VBA]