Cut and paste in Excel

[bloomingflower]

Hi,

I have a problem: I need to line the same people in column B and currently it looks like this person is always in one cell from A-H but not always in column B as desired. If this person is in for example column H then I have to move him/her to column B and person from column G to column A (the rest can be deleted). If this person is in column A then I need to move that person to column B. There is more data for the row (after I column) and I need to get the name via InputBox.

Thank you in advance!

Example:

Jack	Bob	Mark	Frank	John
Bob	Mark	Frank	Alex
Mark	Frank	John
Frank	John
Bob	Mark	Frank	David
Frank	Tom
Jack	Bob	Mark	Frank	Alex

Desired Outcome:

Mark	Frank	John
Mark	Frank	Alex
Mark	Frank	John
	Frank	John
Mark	Frank	David
	Frank	Tom
Mark	Frank	Alex

 

[bloomingflower]

I was thinking about such solution. First it should have InputBox, and then it should go to the loop. If this text is in A then it should move this value to column B. If it is in B then it should do nothing. If it is in C it should move B to A, C to B, D to C and E to D. If it is in D it should move C to A, D to B and E to C. If it is in E it should move D to A, E to B and remove C. Is there anyone who could code it for me?

 

[bloomingflower]

Is there anyone who can help me with it? Please, I really need it.

 

[mikerickson]

Here's the re-arrangement code.
You will have to adjust the rngInput, rngOutput and keyName values to meet your situation.

Sub test()
    Dim rngInput As Range, rngOutput As Range
    Dim arrInput As Variant, arrOutput As Variant
    Dim i As Long, j As Long, k As Long
    Dim outputColumn As Long
    Dim outRow As Long, outCol As Long
    Dim keyName As String
    
    Set rngInput = Sheet1.Range("A1").CurrentRegion
    
    Set rngOutput = Range("A15")
    outputColumn = 2
    keyName = "Frank"
    
    arrInput = rngInput.Value
    ReDim arrOutput(1 To rngInput.Rows.Count, 1 To rngInput.Columns.Count)
    
    For i = 1 To rngInput.Rows.Count
        For j = 1 To rngInput.Columns.Count
            If LCase(arrInput(i, j)) = LCase(keyName) Then
                outRow = outRow + 1
                outCol = outputColumn
                For k = j To rngInput.Columns.Count
                    arrOutput(outRow, outCol) = arrInput(i, k)
                    outCol = outCol + 1
                    If outCol > rngInput.Columns.Count Then Exit For
                Next k
                outCol = outputColumn
                For k = j To 1 Step -1
                   arrOutput(outRow, outCol) = arrInput(i, k)
                   outCol = outCol - 1
                   If outCol < 1 Then Exit For
                Next k
                Exit For
            End If
        Next j
    Next i
    
    rngOutput.Resize(UBound(arrOutput, 1), UBound(arrOutput, 2)).Value = arrOutput
    
End Sub

 

[bloomingflower]

Thank you [U]mikerickson[/U], but unfortunately the code below is removing all data from A-F columns. It is not moving Frank to column B and others to another columns. Could you please tell me what is wrong with it?

Sub macro()
    Dim rngInput As Range, rngOutput As Range
    Dim arrInput As Variant, arrOutput As Variant
    Dim i As Long, j As Long, k As Long
    Dim outputColumn As Long
    Dim outRow As Long, outCol As Long
    Dim keyName As String
   
    Set rngInput = Sheet1.Range("A:F")
   
    Set rngOutput = Sheet1.Range("B")
    outputColumn = 2
    keyName = "Frank"
   
    arrInput = rngInput.Value
    ReDim arrOutput(1 To rngInput.Rows.Count, 1 To rngInput.Columns.Count)
   
    For i = 1 To rngInput.Rows.Count
        For j = 1 To rngInput.Columns.Count
            If LCase(arrInput(i, j)) = LCase(keyName) Then
                outRow = outRow + 1
                outCol = outputColumn
                For k = j To rngInput.Columns.Count
                    arrOutput(outRow, outCol) = arrInput(i, k)
                    outCol = outCol + 1
                    If outCol > rngInput.Columns.Count Then Exit For
                Next k
                outCol = outputColumn
                For k = j To 1 Step -1
                   arrOutput(outRow, outCol) = arrInput(i, k)
                   outCol = outCol - 1
                   If outCol < 1 Then Exit For
                Next k
                Exit For
            End If
        Next j
    Next i
   
    rngOutput.Resize(UBound(arrOutput, 1), UBound(arrOutput, 2)).Value = arrOutput
   
End Sub

 

[mikerickson]

The code in post 2 works for me.

In post 3, I'm suprised that this line doesn't error

Set rngOutput = Sheet1.Range("B")

What do you want that line to do?

 

[bloomingflower]

The code in post 2 works for me.

In post 3, I'm suprised that this line doesn't error

Set rngOutput = Sheet1.Range("B")

What do you want that line to do?

I want to have all Franks in column B. And others in appropriate columns. If I have placed for rngOutput A2, then B2, where my data starts it has a problem with line

rngOutput.Resize(UBound(arrOutput, 1), UBound(arrOutput, 2)).Value = arrOutput

If it was

Set rngOutput = Sheet1.Range("A:F")

macro did nothing.

As this macro has to work only for columns A-F I know that I have to place it somewhere, that is why I have placed in in rngInput. But I am trying to get a final result by changing rngOutput but it doesn't work with these settings (column B, columns A-F, A2, B2)