Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)

  • Sample content is within C3:K500 (of Active Workbook, Active Worksheet)
    1- Need to look through column K for cells = to "L" (would like to be able to use either alpha or numeric values)
    2- If found, then copy whatever is sitting adjacent to it in column C
    3- Paste it to 'Sheet3' starting at cell A2 going down


    Example:
    K5 has a "L" value, so C5's content would get pasted into Sheet3 starting at cell A2 (going down as follows)
    K7 has a "L" value, so C5's content would get pasted into Sheet3 .....................A3
    K9 has a "L" value, so C5's content would get pasted into Sheet3 .....................A4

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    Quote

    1- Need to look through column K for cells = to "L" (would like to be able to use either alpha or numeric values)


    So the value to look for will not always be "L"?
    If not is there a spare, empty cell where you can enter the value to be searched for? If there is then what is that cell address?

    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    I'll like to be able to just enter whatever the value is -- within the code whenever I need to perform a new search..
    Came across the below - but doesn't work for what I need to do -- but the thought was to simply ALT+F11 and change the search value and col refs whenever a search, copy/paste effort was needed.



    I don't really want to interfere w/ the main large table (by adding an area to be able to enter a search value)
    If it makes it easy to do that way -- I suppose on Sheet3 (where the pasted content will lie -- I could manually punch into A1: "Search Value:" and B1: " L " prior to running the code... then B1 would be used as your source info (what the code needs to match to)


    Whatever is easiest..
    Thanks KjBox - I know you always do awesome stuff so I'm confident whatever it is --- it will surely work great! =-)

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    So Row 2 is a header row and data starts in row 3?
    Is Row 1 empty?
    What column does the table start in? Are any preceding columns empty?

    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    Try this,


    Assumes that Row 2 is a header row, and the header row starts in column B (so data starts in C3), and data is in Sheet1, and the value to be searched for is in Sheet3 B1.


    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    I'm attaching a very small sampling showing how the content is arranged in Sheet1. Sorry for the confusion - hopefully this helps!
    As mentioned in the orig post 'content' starts at C3 and goes through K500 of Sheet1 (everything above and aside that is blank)


    **The actual 'searchable/copy/pasteable' data is in: C8 through K12 (in this small sampling) but is C8 through K500 in the orig file)


    =Sheet1-Col K is the column that gets searched (looking for "L")
    =Sheet1-Col C's cell is what gets copied if the code finds an "L" within Col K (so in this image, C8, C10, C12 would get copied to Sheet3)
    =Everything above row 8 is header garb or blank
    =Cols A & B are empty
    =Rows 1 & 2 are empty
    =Rows 3:7 are header garb
    [ATTACH=CONFIG]71945[/ATTACH]

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    OK got that.


    Is the number of rows of data always down to row 500, or is 492 rows of data a like maximum?


    When the contents of the required cells in Column C get copied to cell A2 down in the result sheet does any existing data in cell A2 down need to be cleared first or should the new data be added to the end of any existing data?

    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    In this file, there's approx. 500 rows of content so using 500 is good for this purpose.
    I was hoping that the range could be easily edited to adjust the range if I were needing to use the code in a diff workbook next week that might have 750 rows or the following week, only 100 rows...


    The paste-to area within the 'result sheet' would not need to be cleared first, I'd make sure it was going to copy to an empty sheet starting at A2 and using row 1 to place headers manually which would depend upon the type of content pasted over....
    Again, I'd hope the A2 paste-to refc could be editable -- if I needed to adjust it to not start pasting until A10 to allow for more header content if need be...
    But for this file, A2 is great!


    This is for a tool that tracks software requirements... for a requirements tracking matrix.
    I want the code to extract all the reqs that have not been marked as met or achievable by the team and paste a quick report onto a new blank sheet for evaluation...


    For example:
    COLUMN C....................blah........blah..........blah..........blah.......COLUMN J.......COLUMN K
    Req............................Qualifier1......Qualifier 2......Qualifier 3..... Tot Q's Met.....ClassCode
    contractor shall do w........X..................-.....................-..................1..................L.......
    contractor shall do x........X..................-.....................-...................1.................R.......
    contractor shall do y........-...................-.....................-...................0.........................
    contractor shall do z........X..................X.....................-...................2.................L........


    In some projects, I'd like to edit the vba code to Search for the "L" codes in Col K and if true, it will copy the req info listed in Col C
    and paste them into a blank sheet to quickly see which ones have not been met...


    In other projects, I'd like to edit the vba code to Search for (anything =to zero "0") in let's say Col J and if true, copy the req info of Col C
    and paste into a blank sheet the same way....
    (using the number in some cases will be important because anything = to 0 means we didn't have any Qualifiers to help us meet the req....
    but if the Tot Q's column has at least a 1 or more, then we know we've met that req with at least 1 Qualifier and won't want the req sitting in Col C
    to be copied over to a blank sheet...


    Hope that makes sense and didn't confuse matters...
    Was trying to expand upon what I'll be doing with it -- and the 2 ways it could be re-used to evaluate both an alpha code such as "L" or a number (greater than "0")


    Thank you!

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    Try the attached file.


    Note I have started the data in row 9 NOT 8. Row 8 needs to be left empty, the code can then use "CurrentRegion" for cell C2 to get just the rows with data (however many rows that may be).


    You must insert a new row 8 in your actual file, you can then hide it if you want so that the headers still appear immediately above the data, but it MUST be empty.


    I have used an Input Box in the code for you to enter the column that is to be used to search for the value that will determine which cells in column C get copied. Enter "J", "j" ,"K" or "k" (without the quotes) into the Input box when it appears.


    The code will add a new sheet and place the copied cells into A2 of that new sheet, you can then add the headers you need. I have shown in the code where to edit the A2 to a different row if need be, or this could be done dynamically with another Input Box.


    For your actual file you will need to change the sheet name where I added a comment (near the top of the code)


    Click the button on sheet 1 to run the code.


    Code assigned to the button is

    Files

    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    For the sake of a different approach..
    [vb]Sub kTest()

    Dim v, k, kk As Range, ws As Worksheet, sn As String

    Set kk = Sheets("sheet1").Cells(9, 3).CurrentRegion

    On Error Resume Next
    v = UCase(InputBox("Enter the Column to be used for the criterion value (J [=0] or K [=""L""])", "Search Column"))
    If v = "" Then Exit Sub
    On Error GoTo 0

    With kk
    sn = "'" & .Parent.Name & "'!"
    If UCase(v) = "J" Then
    k = Evaluate("transpose(if(" & sn & .Columns(8).Address & "=0," & sn & .Columns(1).Address & ",""#""))")
    Else
    k = Evaluate("transpose(if(" & sn & .Columns(9).Address & "=""L""," & sn & .Columns(1).Address & ",""#""))")
    End If
    If Not IsError(k) Then
    k = Filter(k, "#", 0)
    If UBound(k) > -1 Then
    Set ws = Sheets.Add(, Sheets(Sheets.Count))
    ws.Range("a2").Resize(UBound(k) + 1) = Application.Transpose(k)
    End If
    End If
    End With

    End Sub[/vb]

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    Thanks for the variations! Let me address each below:


    Krishnakumar:
    Sub kTest() failed at this line: k = Filter(k, "#", 0)
    (RUNTIME ERROR 13 TYPE MISMATCH)
    I see that it's referencing 'filtering' - and wonder if the fact that there's no header in row 1 - if that's what causing it to fail?
    I manually turned on filtering using row 5 as the header /filtering row and believe if there's a way to define that we want row 5 used as the header in filtering - it might solve the problem?
    I'm guessing here - so sorry if I'm way off --



    KjBox:
    Sub CopyToNewSheet() ran without triggering any errors on the attached test file; however, there's an error present as far as the result.


    (Using the test file you attached), I ran the code using Col K.
    There are 10 "L"s in that column, therefore, 10 items should be on the results page. (but there were only 9) - looks like it's dropping content present on row 9. "Contractor shall do 1"
    Re-ran using Col J (which should copy over anything =0) and it's dropping row 9 again.


    I inserted an additional blank row (so now both 8 and 9 are empty - with content starting on row 10) and it seems to work! (both Col K & J)


    Next, I copied the code into my larger test file,
    inserted a blank row (to ensure 8 was empty) - ran and got error
    Here's the row that failed: If x(i, 9) = "L" Then
    (RUNTIME ERROR 9 SUBSCRIPT OUT OF RANGE)


    inserted another blank row (to ensure 8 & 9 were empty) - ran and got error
    Here's the row that failed: If x(i, 9) = "L" Then
    (RUNTIME ERROR 9 SUBSCRIPT OUT OF RANGE)


    inserted another blank row (to ensure 8,9, & 10 were empty) - ran and got error (THIS TIME A DIFF ERROR)
    Here's the row that failed: (after Case "K") For i = 2 To UBound(x, 1)
    (RUNTIME ERROR 13 TYPE MISMATCH)


    inserted another blank row (to ensure 8,9,10 & 11 were empty) - ran and got error
    Here's the row that failed: (after Case "K") For i = 2 To UBound(x, 1)
    (RUNTIME ERROR 13 TYPE MISMATCH)


    Positive Note: love the fact it inserts a nice new sheet on it's own without having to manually edit the code every time I use it on a diff workbook...


    So, with that, I think I'll hold off til' I hear back more from you-all on what I might do to correct problems with the two sets of code.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    Sorry my error,


    change

    Code
    1. For i = 2 To UBound(x, 1)


    to

    Code
    1. For i = 1 To UBound(x, 1)


    Note that this line occurs twice in the code.


    There should be only one empty row above the data (Row 8)

    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)



    replace


    [vb]Set kk = Sheets("sheet1").Cells(9, 3).CurrentRegion[/vb]


    with


    [vb] With Sheets("sheet1")
    Set kk = .Range("c8:k" & .Range("c" & .Rows.Count).End(3).Row)
    End With[/vb]

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    KjBox:
    Sorry about the delay- got pulled to another deadline - now back on this one!
    I edited the code as you instructed and it works on the test file but throws an error on my real file.
    I've got Row 8 empty,
    content starting on Row 9,
    Code "L"s in column K,
    it generated a new empty sheet - but empty and here's the error it threw:
    RUN TIME ERROR 5: INVALID PROCEDURE CALL OR ARGUMENT


    Here's the row of code it highlighted in yellow:
    .[a2].Resize(ii) = Application.Transpose(y) '// Change a2 to other start row if required


    Any ideas what's causing this new error? (of course, it might have always been an issue, but the code previously didn't run down to that point until now) - following the suggested change.
    Hopefully it's another easy fix?

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    I decided to put both KjBox and Kris' code into the sample file KjBox posted to see if both would work in that small - simple file w/ no special formatting.
    Result: both sets of code worked


    Next, I took my orig file (used for testing) and stripped out all the real data of which many of the cells held a lot of content each - but didn't think that should matter --
    none-the-less -- I wanted to see if some kind of formatting of my orig file was causing the issue --
    Result: Kris' works on this stripped down larger test file (sheets 1 & 2 were the result of using Columns K and J)
    ............KjBox got errors on this stripped down larger test file (sheets 3 & 4 were the results)


    Still frustrated as to why the real file doesn't work for either set of code (already posted individually in the previous posts to each of you what occurred)
    But thought if you saw what my real file looks like -- perhaps you'll see what might be causing the issues?


    I hope so!
    Thanks soooo much for your help - figuring this out! (ATTACHMENT)


    ozgrid.com/forum/core/index.php?attachment/71983/

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    KRIS:
    I typed up the result when I tested yours in my REAL file - but for some reason the "Reply" is not showing up now -- so here it is again:


    I updated the code as directed (removing the one chunk and replaced w/ the new)
    Still getting the same error
    RUNTIME ERROR 13: TYPE MISMATCH
    and on the same line:
    k = Filter(k, "#", 0)


    (it occurred both times when I ran it against COLUMN K and J) - same error - same place


    Here's the code for refc:

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    The macro failed because Col C has value which is having more than 255 characters. Try this one


    [vb]Sub kTest()

    Dim v, k, ws As Worksheet, Dest As Range
    Dim i As Long, c As Long

    With Sheets("DETAIL-REPORT-ALLS")
    k = .Range("c8:k" & .Range("c" & .Rows.Count).End(3).Row).Value2
    End With


    On Error Resume Next
    v = UCase(InputBox("Enter the Column to be used for the criterion value (J [=0] or K [=""L""])", "Search Column"))
    If v = "" Then Exit Sub
    On Error GoTo 0

    Set ws = Sheets.Add(, Sheets(Sheets.Count))
    Set Dest = ws.Range("a2")

    c = 9
    If v = "J" Then
    c = 8: v = 0
    Else: v = "L"
    End If

    For i = 1 To UBound(k, 1)
    If k(i, c) = v Then
    Dest.Value = k(i, 1)
    Set Dest = Dest.Offset(1)
    End If
    Next

    End Sub[/vb]

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    WOO HOO!!! it works Kris!!!
    I wondered if having many cells with a lot of content in each cell were affecting it ---
    Man am I excited...


    Just out of curiosity, with your code, is it also required that a row be blank (such as the row 8)?
    I see that the latest code obviously refers to a range "c8:k" but just wondered if the added blank row was necessary, or if it could be deleted, and the range changed to c7:k? (for future refc, when using it other workbooks that don't have a blank row)


    As Kj mentioned, it could be hidden if desired-but he stressed it was required w/ his code -- wasn't sure if yours was written-- to also have that same requirement or not?


    MANY THANKS FOR YOUR HELP IN GETTING THIS WORKING... SUCH A HUGE TIME SAVER THIS WILL BE! :thumbcoo:

  • Re: Simple Copy Adjacent Cell if This Cell is Equal To "x" (vba)


    Kris, can you do me a favor? I've commented out the code as best I can for future reminder sake when I go to re-use it in a diff workbook--
    I'm not sure I understand the very end -- what it's saying/doing -- can you expand on it?
    Specifically this chunk:


    Code
    1. For i = 1 To UBound(k, 1)
    2. If k(i, c) = v Then
    3. Dest.Value = k(i, 1)
    4. Set Dest = Dest.Offset(1)
    5. End If
    6. Next
    7. End Sub


    Here's what I have - feel free to expand, change if I'm not reading it correctly..