Cut and paste in Excel

bloomingflower

New Member
Joined
Mar 9, 2020
Messages
19
Office Version
  1. 2019
Platform
  1. Windows
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:
JackBobMarkFrankJohn
BobMarkFrankAlex
MarkFrankJohn
FrankJohn
BobMarkFrankDavid
FrankTom
JackBobMarkFrankAlex

Desired Outcome:
MarkFrankJohn
MarkFrankAlex
MarkFrankJohn
FrankJohn
MarkFrankDavid
FrankTom
MarkFrankAlex
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

bloomingflower

New Member
Joined
Mar 9, 2020
Messages
19
Office Version
  1. 2019
Platform
  1. Windows
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

New Member
Joined
Mar 9, 2020
Messages
19
Office Version
  1. 2019
Platform
  1. Windows
Is there anyone who can help me with it? Please, I really need it.
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
24,079
Here's the re-arrangement code.
You will have to adjust the rngInput, rngOutput and keyName values to meet your situation.

VBA Code:
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

New Member
Joined
Mar 9, 2020
Messages
19
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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?

VBA Code:
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

MrExcel MVP
Joined
Jan 15, 2007
Messages
24,079
The code in post 2 works for me.

In post 3, I'm suprised that this line doesn't error
VBA Code:
Set rngOutput = Sheet1.Range("B")
What do you want that line to do?
 

bloomingflower

New Member
Joined
Mar 9, 2020
Messages
19
Office Version
  1. 2019
Platform
  1. Windows
The code in post 2 works for me.

In post 3, I'm suprised that this line doesn't error
VBA Code:
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
VBA Code:
rngOutput.Resize(UBound(arrOutput, 1), UBound(arrOutput, 2)).Value = arrOutput

If it was
VBA Code:
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)
 

Forum statistics

Threads
1,147,517
Messages
5,741,629
Members
423,674
Latest member
Charles2dodo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top