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

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

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]

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

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


http://www.vbaexpress.com/forum/data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAANYAAAETCAIAAADF02/KAAAaHElEQVR4nO2d229UR57H61/Y5DEv+QsQkrWHh0X2IMFs7wqk1YBGGjejmbFsLxvWsCtZYph0HjyIDpcXr+0oY2hZzIqNDbsYN3 EDi800IEObENLB6yQkOO6ASQIBjG8wQsI6+3BudTvtqnO//EpfWd11zqlTfc7Hv6o63VVfpIql5ZWXoOhIVdWLl68l474gYQRfgKIjVVUvjF9Lxn0RRXBp5QUo OlJV9cL41WTcF2EEl1+AoiNVVc+PXU3GfRFFcHH5BSg6UlX1/NiVZNwXcQRXXKt6rCPXPlDFM2dKve0dvedq7gvHdGuovSOn6Y+lB16W7PBTe/0Bl1dUVS1duuLRfQlZwggurbhW9VhHrr1jaNLKeXDu/Vx7R++5WfeFG/pkiDxF6Koe8/YDLq0sLmEIhv8B3UoUwYWlFdeq9nf09g/0dpUe6DmfDHWVxvs7eouz5g659o5c+0DV3L9Y0kOacVSV3N98relB8X0qhyyZPLZ/oFcruTJAn9dm04Pi+zlOfehK4p9lyKzkTKm3vSPX3jFUcX0xVVUd/d+yR/clZAkjuLjiWhox1f78+MziysLiSmWgtzhrYLS4UhnI9d9cWVh8UMxrOdV+7d4vrizcHGrvGKpYh eAFYqeYHe8yCsdVGch1jT7Qy9F3qPZ35LpGHyzMjnd15PpvrizMjndZp7DbhH8Wa2emkuQZO8yP QxXiXBaCHhUYokQRfL647FrV/o6ekdnlGwO5/pvLz2fHuwaqZubzRTNQ5do7cv03l7FNy+RubKah2fGu/Pg9m/PalCP1Yvn5zUGjknXqw828P5LPtQ9UvbiSy6qqfnzxLx7dl5AVAoIafPdGe0jOGJ4cIMjJWbMcm Rc3B9t1xOvXx7aS90Z72jsGbwCCDhCcX1h2rWp/R8/IzPL8wv2RfE/XwPg3dGaua/Q+b396t/7J5fmF5fnJwXZrB13fjPa057WSLV0fMEqeHDS2mgXKvJgcbB+okqe2raR1RqKS90fydJ0daHV19 dzFy6urq17cl5AljuCSa33W39EzMrM0v7A0PznYNfodnTkz1qW3cYPXqU3ksXpTODCI7WDpm9Ee s0HHzmK0nnSBsi+oU9tU0vwsxJ5azmfuL6aqqucuXPbovoQsUQSfPV8CRUcmgqHXxL1EEfzp2SI oOlJVtXh+PBn3BRCMpVZXV4vnx1dXV0OviXshwfT943lQdKSq6sj5cVVVQ6+Je4kieLT7QxDID4 kieOPmbRDID4kiOH13BgTyQ6II1uZ+BIH8kCiCx058BEqnjp8YPH5i0L/yJRAUfHwDKQHp+cLiSOnSf50euXyt8tnU3c+m7tbmHvkkQBASnapTX/x58Mz1T6r+YQcIQrJNoxcvD3988e63D4LhDxCERKTq1BfDH18MDD5AEBKRni8s/nnwTJDxDxCEZKXXr1+PlC4F1v9LL4LlToQQ6izT+bVCBiGUKdSCr1JE0g8/Ph488zEFx+fTX49fvXGmeP5M8fz41RufT38NCLpM5U6U6ezMkAyWOxHKFMqFTKoRrHxy+y8TN3E ypr68d+FSefjcBVMXLpWnvrwHCLpI5U6UKdRqhYxNHEwzgqMXL1NB7sat6sXxK5Ru3PK+pU4Rgh qBNrQlFsG/4yV2t8H/KX557zucjMqt29cnb1Gq3LoNCDpNGGM83BKLoMpQyN3n5Klhaiw89cXdqemvaH3h/dckaUGQQIzDW5IRVDEK7XYYKV2a+nIGJ2P2/ve1+w8pzd7/HhB0lrQhL5FI4BKOoKqqdfhTVfXy1evUE5n7Dx8//unpk2fPTT3+6en9h48BQUdJG/XWrIxaIUM+nEk+gvXTzOx37Pcicz8+eTK/uLjyYnHlxZP5xbkfn3jOX1oQLHeyDwPNPO1ZoV10TEt69erVR/89QrXFwSgVCEISSTOz3w2e+fjb+z8AgpBCS5evXh8rXwcEIYWWXrz868lTw9TXJIAgpEDTi5d/vTBWPnW2NP31LCAIKbT09b1v/3NoeKx83aefJjhEEJQ29QdyFlEE/+PYcNj/mZCSmeQQrM0tgEDeChAEhSwJBPOQIPmQRBEsli75rWtH1qv/9ytQkLp2ZH2QjwBdjYiLpUt+V+XakfXqdDMoSAGCDIJfZEFBChBkEPxqJyhIAYIMgnd/DQpSaUdw6ivi12nXjqxXv/lN7FTZpyiKouz7Reg1caBUIzj11czlaxUawXu/jZkmtrYoSn7fFkVpHJoIuzLySi+CGn8cBGd+Fy/N9TYqypbKxLYWRWnpzYZeH1mlFEGTPw6Csy2x0o68oii/36HOtlR+ryjN2+bCr5Kc0oggzh8HwVprnHT254qi5M8yr+Oj1CFI8cdB8H5bjFT5g6IomYr+9pd 5RVH+8MvQayWldCHI8sdB8EF7bPTJP7UoSsuHvzFzdCJDr5iMUoQglz8Ogg//OS6a+1OTwkstf/pt6HUTV1oQtOOPg+D3/xITNecVRdn5izki83dDO9nMSCsVCNbhj4PgD+/EQ6P/oChKfpTOn+v/GTc/sko+gvX54yD4aHcsVHlPUZR/rHA2ZfOKoryXDb2Ggko4gmvyx0Hw8b/GQJ9vb1GUluOt3K2V9xRF+dnQ52FXUkxJRlCEPw6CT/aAglSSEXSga0fWq0/3goIUIMggOP9voCAFCDIIPv93UJCKE4LXjqwHJVIBTEyrL1EEg/nh0PF33gAFKYTQ8XfeaP3gWYiKHILhXo5UCRAEBEMWIAgIhixAEBAMWYAgIBiyAEFAMGQBgoBgy AIEvUVw+Y5KpztjLi7N2CtVfTXg7eUee2VVbv7lgbDrk3QEJ7a1KFsqwSJIMDf2SlVfXzzlBhcH t3zh4rz66PYCu+nA7dd4fQZmVbnyAUFJBHfkFUUJF0F7Gvy85XYnZau3fEeVqR4gKMHfmS3GVJ7 wEbwzZmLx8o5qBB68QSQ4sFrzO7PmLSdLJlDAWv/5lwf02KaqqqrOLksAJFcf8rwuuEwogsbSFvpKF+EhiDV8CxfnsVt16uUjGiltNyIsYQ2lHYLM/vMvD9hEwQO3X9t2/jyrDyBIKhQEyWR2vEgs6HtmbKXyx9aKgvx7L4+gbH14+zsbeAGCfjfEfCwYGvStdP5aCNpQZdMX tI9VsvU5cPs1M/R32OUFBMNBMJQoWG844jYKOhcgGBKCQn2vZWvsQhyO50v0BVvrPJSRrs/yHXy4Qx0OCMYAwQ/sR6CnXj4y+5G3X1EjGH34WXdE3Go2lNyen92jadn66AMsY7Ds9Ak8IOgtgiBpAYKAYMgCBAHBkJ VwBB0IEAxYgCAgGLIAQUAwZAGCgGDIihmCwczsV1UVIfQ3f/srkN9CCJlPFkUhCDcFEwURQqqqXrgH8l0aeVogZL90DjIBgikVIAgIAoKAYLoFCAKCgKBvCM71N lpGMPt2AILRVGIR1PjTbVG1eUzCFGIIlrfT5+88TF7Bw62cTVgmtam2d6ORt7Fwgn9XytsR2n6S zDzZSZ4aK8emqBMHM4gtJ3piECx3ItRZJumw8sqdiNlMbqWPxVKtkGGOLneKoieH4I48yZzUjxU oBIm7eLITv68nDmZMMg63WigcbkUNB2vM5a7t3YhQa9nC1Hgth+CVQgMijj3cihDK7L3CnAvZnS JCcoIgtYMoghqBtgd7iuDEthZFyZ+hgmLj0IRrBDXsdNTK2xGG2pVCg85Bbe9GXvixdqDKkUKQ4 JigEC/tSqEBdR7W/oYNmecIZjIZYhdBBGuFDOosa399R5BRZZ/EbOL6CFokkUhhqu3diBo2ZowqcyGo7d3IjZRrIWh3Upbv1nLds0RFDhDsLJM7iSFosFcrZFCmUA sUQaJf6B5BM1PD4qTZlzAJIKLj4VaaQr2n6KwvSHcKuUdZr+1jbVTkDEE9HGokCSFobSIZ9Ksvi ElyLCKJoNUm4v3CtZHC9tfGDXpqLXuAINNxjPKgxCmCGIQiCOJbagWsIfc5CsrGP7mGmKaB7Bpa smsN+Wi6b4iZ8XikByXOETQhFECQE+swkP1CsLJPccDfmgiSwxGcBrKBZpGyyxdAFjspNRzRuce GI9xRfHQHJQyCVF+NyqIgo0Yndggy+TxqPUZQi3/4oNgTBKmHbfg4FGuIy9sR+fCFC4c9GScOZoiHLFcKDfTQG6NQe2vsz+sP2IXnSIhBUGsnMQiJ91 yYUH0EiYYXZ5dsxT1F0FjTyAF/LIJEYrr23EfTxIHEIXiBdSPTSaLlYIIl+Wi6taC9bThY4NLGDomiIxZBDCzjSpFhj0MT+dQQT5l CoRPRYRU7yp/hCPHVnJUcPBeMk06cLEd55CuHYBjJSwRdKqYIxlSAICAICAKC6RYgCAgCgpIIBjODTptQ+PcHpk F+S5vEqSkekziDiYJvvf3mw9rTj24sgfzWw9rTt95+8/g7b2jXPEQBgikVIAgIAoKAYLoFCAKCgKBvCGq/lJH6ag4QBAQ9Q5D4pf6ZLVK/msEQLG1FaGsfedX69iC0J6e/nW7bYNRsQ1+PtZtdPq41C2czmUP69tQ9RQzEIFjchdCuQZKPwd0I7T5tbEVtxTpb6WMxTR7ahOg dirtE0ZNCkJ6+lB1qlpvEKYbgdNsGhLIlLT+XNV/b5XuNYN8exJYQNzlBkNpBFMHq0UaEaIKtQzyOgqT8QXC4bx3a3Das5/fs36xHI7t8bxFMBH/OEGxq3GS8lUFworsJ7T6t/Q0YQakZnJINsanptg1o3f5p5hLb5btDMCn8OUNw1+DT021YMBNDcPLQJtRW1GJh06FqUAgafrBS P1+lEOQlgpJcFiHE6ZDZ5btFMLuHrUN85QxBPRxqJAkhaG2aPLQJNXZP+tsXpLUjryhK87Y5H6P gUs/+zfXze/Zvtj5GtuQYQYTQ1j6iuxlrOUVQy9x0dEIMQWsfrUU2dwuoLyi9moIDBPk7y+aL9wWH+9YhuyY+T nKOYO3p6TaEGrsnBRA83caQpLfjQSEo9VxGFEEaF7yjxsunrz6nm2iOXYhxtM2IuGf/ZoSNe2IqBkGqr0Y1nRRk1OjEDkEmn0etpwi6XlNGLAqyj0jq59OiGcIDG3YUhiNVH+3pY7w7hQy C2tO7TUcn8JGsCSUXJlQfwclD5AjaZPdQ1b8oSD2F2ZGXXNBDuCHGxyt05OPlM9KeLRsJP5c+mi FKYOujnSjGFLIIYmDpiQp7FGSn2xD11BBPTYe6rYEL5yg/hyPYF3SOR8Th36HEi49gGPIeQccCBAFBQDBFAgQBQUAQEEy34ocgzKBLmGAGHT8KIphHDPOIAcG UCBAEBAFBQDDdAgQBQUDQfwQr+yR+LAgIAoJeI6j9cNohgmvawdl5yrn2miNXkMYPoTLj4jUnjG BCPOhM7chrv1PwBUE7TzkvvOZ0BDkOeCSCsfGa8xLBGHjQGZrrbVSatw05b4glLEAsXwZPvOauF BpQZntrhrI7bGjtbKAX44+H15yHCMbHg25iW4vSODThpi8o4suqyc7fxp3X3EmcrfJ2PSeWXnMe IhgXD7rsULP+M0GXCPKSkKecK685PZRipp4nO9HGwgkixMbJa85bBGPgQac1wRp2gURBWw86h15 zBmpGnDM8jnEEY+U15zWCEfegM5pgNUAE5Tzl7PLZjqbezzPMxmLrNec9glH2oPPO+kbKFNNTrz nKYPtgoYHOj5nXnDCCSfGgw+VbFLTzlPPCaw6LdloLTuXHzmtOGMFkeNAFhKBq7ynn2msO7/NxXvNpi7LXnDiCGFjGFSTDXgw86LxDEBQSgmEkHxGUFSAICAKCKRIgCAgCgoBguhU/BGEGXcIEM+j4URDmEcM8YkAwLQIEAUFAEBBMtwBBQBAQ9AtBY9aImZxY34R/hxKv5CJ4Zous+yEPwdA96LBybIrSvCTia4PDIJgMDzr9J4OGDaJfCPrsQTfctw4Rx+ayiFli32A 0th4kThCMhQddZZ9Ey+sQQX896PjmNrksGQuH+9ahPTntb9gwBYZgLDzoskPNSkuz9dtpNwZg4X jQkRxbYvnOluqeJepygGAsPOh25InxhysnTl7y34NOyOPJem0fa6MuZwjGzoNObnQSCQ86EQSZj mMcByVOEYybB50vBmB14HCcL9MQY944ONnhUxUQguBB56sHHTMcKW1FaN3+aWw4whRr7zQWZTEI JtmDTvQZTSQ86G4wD2W0t8b+vHZfxzR0qtwhmEwPOmtxD68bYh896D66sUQ/ms72aW/X7e/j0pbLrnW66IlFEANLT0nwoBNsghkEw79DrHr6SnEc+cohGIa8R9CxIo5gwgQIAoKAICCYbgGCgC AgKIkgzKBLmGAGHT8KIphHDPOIAcGUCBAEBAFBQDDdAgQBQUDQPwQ16y/J6XOAICDoEYJntlgrq05sa5GcxGkgGJ4HHVsOXRTriRKzJX5tEEyIB92OPDlfRPbHWmII+ulBd8 +woSMNwBDP9wY7Nn7WI04QjIEHnYtJxBII+upBR3JMUKiXxjk8jh5MDhCMgQedEfOwBRUc9gXD9 qC7whxVx3ekzlERlgMEY+BBZ1jfmIFQegYdjiAv+e9Bt7bHE9dRx85mJ7pyhmDUPeg0BImfSUvO oJOPgl570AGCayAYbQ+6ud5GGjjJ6UsOEPTLg446ChriWHjQcWKeHwj66kFHD0d0u6UUDEeS4UE 3sa2F0xB7/lDGTw+6e8xDGe2t/UMZraGPVyvMQzApHnTkg0DpGXRiCKo+etDpIh9Ntxa0tw0Ha5yhUtzinx2CGFjGFSTDXnw86LAv 6GSXNTIQjKJOnCzHETU5BMNIPiDoVBFHMGECBAFBQBAQTLcAQUAQEJREEGbQJUwwg44fBWEeMcw jBgTTIkAQEAQEAcF0CxAEBAFBPxDU5isxSX6t6fDvUOKVUARp7cgrijWhTgLBsDzoGOulvj2IXN lXW2u6DTeSwFKMVpzmIWg4dSGEGYTUyccX66XWlMaFHU6X4DOClX2K1GymSHjQkYuk57Jo3QbC3 IYu1s4kIvJiEKwebbSclTCXJbt84jVpa4NporsJEe5z9KLqPiLI/nbQKwR99aAjCplu24C29pW2WjnMsYlBcKK7CSPDQkosn36Lxz/Kv9O0LfEbwco+RdaSMxIedPiBusuhBqINcIlBkEGHXSyfyMdtlYxGmfZ94HMZUF+QMqNzgiAv+e 9BhzW1htch+YIqNnEI6n5JTKtK54sgSO/DVdEXBDnzmPyKgl570GmvN/T1aB1BIhxiOclFEOuxceix8p0gyBu+kE4nniFY2ScxEHaJoMcedPoOm9uGqS6glsMcmFAE1/b0ctMQY8dyTOq8QNBJKyyBoL8edPoOW7N7qIHwuuwejgF2YhC0Q8ou38VwhDV79xpBxonO6yjos wed2XYzDwg5T3kSgyAVxuxcNqkAJvZQhhjZYOZ1WrPuA4JOFzeKkAcd6zLMYJo4BG36ak7yebEQ 33Oiu8mwoWs6VPUeQWdjERW+oAsfwXDkPYKOBQgCgoBgigQIAoKAICCYbsUPQZhBlzDBDDp+FEQ wjxjmEQOCKREgCAgCgoBgugUIAoKAoH8IggddHJRcBIn1zeV+teXeg053HLGS8Ar93IWpxTNjKA bBhHjQZYeaiR+rSv1kwbUHnXq41c5xCRD0AsEYeNAFg6Ct11xt70aRle8BQYcIxsCDjt8Qy0xlF 4uCuHATkdrejahho+m1ZAcKIOgQwRh40OnClvVwuuK+Mw863aYG2wp9QY8RjLoHnUqvoJAdapaY TeytB51ZiJwHHSC4BoLR9qDjraBAm2R7jqCU0Zft/oBggjzoqIlLEn6wUfCgI7zcjQK5maEz5DWCSfWg8yUK1vOgIx7W2Fhz1fOgwwizyONmxlwMgknx oAuqLyjgQVffGs7egw57vm2VzM2MtVgEMbCMj0qGvdh40Bne7Ioi80RGhS/oooBgGMl7BB0LEAQEAcEUSUutHzwLkz5VVaOJIKQAknZbtSgY7mWPHIKQAkixRDCwGXSgAIRPnz Nzoj6Drjb3yG8VS5feevtNUADSJhGb84jDnUocLQTDnVOdKgGCgGAk1PrBs9DrAAimWoAgIBiyk ong5Ic7ja/ndn7wKSAYaSUQwbPvYuSde09RlP3nHCC4poMA3xWNWb6du/ps3cI1wyp65W5tRVsic/LQJsRfkz5OwhCsf82LuxCzcLndetSMeNdKZqFzCQQ/PdasKM0fVgkis8cmPUawnisazzPIAYLkDvoK3TiCxv8Au5x8rCSHIOeyiCDIvVbWIZ4iyIS9yQ9 3ijfHogjauaLVqkcbRcLS2oXvatuEX6/TbaipbTfjcWAu2x0+ScEg2NRI+uEIIsi/Vj4iSADnC4LMf5gR+apHG7XLpCU7OAT4HsSvV3GXnkNy31a092qLjaQQ3DVItDmCCNpcK58Q5Db Ewt1BCkFeIqhi3NJ0EwFsq7O+4KajE1hAHdyNGrsnidBrlWDrtxETySJIXGQhBO2ulU99Qd5wxD GCgp56dm5pZiFaX1hPbUXBVt743zX6lziCeE0mupviPCiRR1DL3HR0QgxB22vlUxTEIp+iKEr22 OSnx5r9bYjrfH67VlKso2nZs5hvdQQ5tmmxHZQ4QdA0FBZA0P5a+Ykg0zt876zYzqIIyrqlCaDJ c3quHm1Euw51N9H5TLFClqcRFYZg3ctCf2pqdLKWZ2Jdpv1F8Oy7ivJuSXBn4ShYzy2NeFhj00u jvelxnzQs2mktOJXPa/eJPmi8hD+arndZ+DCh+gjWvVZ+IVjar1jMSQ2HJRtiAVe0+qME0gbXOhfe5+O85tNmP/SJuuhvR+wuC++OYJ+aM7ZoOtRd91r5NhzRBsVGEm2CGQRBASmBX9C5ESAYvABBQDBkAYKAYMgCB AHBkBUnBIulSwEoXDM0UCiKVhQMcTZrOlNrjFZTAAQTmQBBQDDkBAgCgiGnKCD4/6S77S1Y3fNxAAAAAElFTkSuQmCC
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:

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

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]

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

[mperrah]

test 3, still kicking output wrong

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

[mperrah]

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

Thank You


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

[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


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

[mperrah]

Got this to work.
There is probably a cleaner way, but yeah, I got it.

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