Finding and Moving Cells

[rossmiddleto]

Hi Everyone,

I am looking to do the following.
1) Find a cell called 'test' in sheet2 of my workbook.
2) Cut the value in the cell to the right of the 'test' cell
3 Find a cell called 'test' in sheet1
4) Finally, paste the value found in step2 to the cell to the right of the cell found in step3.

My code is below, any help will be much appreciated!

Kind Regards

Ross



Option Explicit
Sub Arrange_Cells()
Dim sourcecell As Range, sourcecell2 As Range, sourcecell3 As Range, destinationcell As Range, destinationcell2 As Range, sourcerange As Range
Dim matchrow As Integer, matchrow2 As Integer

Set sourcecell = Cells.Find(What:="Test*", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set sourcerange = sourcecell.Offset(0, 2) 'Selects cell in same Row, 2 Columns RIGHT
sourcerange.Cut

Set destinationcell = Cells.Find(What:="Test*", After:=Worksheets(1).Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

Set destinationcell2 = destinationcell.Offset(0, 2)

Set sourcecell3 = sourcecell2
sourcecell3.Paste Destination:=Worksheets(1).Range(destinationcell2)

Set sourcecell = Nothing
End Sub

[shrivallabha]

Provide a sample workbook. It always improves your chances of getting the "precise" code.

[Charlize]

Sub get_value_2_col_from_test()
'mycell is result of lookup, myfill is where you want to paste
Dim mycell As Range, myfill As Range
'wssource is worksheet to copy from
'wsdest is worksheet to paste to
Dim wssource As Worksheet, wsdest As Worksheet
'mywb is current workbook
Dim mywb As Workbook
Set mywb = ActiveWorkbook
'we start of with sheet1 as the activesheet
Set wsdest = mywb.ActiveSheet
'the sheet to copy from is sheet2
Set wssource = mywb.Worksheets(2)
'look for test and start from a1 and store the value of
'2 columns to the right in mycell
With wssource
Set mycell = .Cells.Find("test", .Range("A1"), xlValues, xlPart).Offset(, 2)
End With
'look for test in destination worksheet and get the position
With wsdest
Set myfill = .Cells.Find("test", .Range("A1"), xlValues, xlPart).Offset(, 2)
End With
'change value of myfill to mycell
myfill = mycell.Value
End SubCharlize

[rossmiddleto]

hi Charleze,

I worked on my code over the weekend and came up with the following that seem to work:


Sub Move_Cells()
Dim variable As String
Dim i As Integer
i = 1
Set com = Sheets("Sheet1").Cells.Find(What:="Commodities", LookIn:=xlValues, LookAt:=xlPart)
Do
Dim sourcecell As Range, destinationcell As Range
Set sourcecell = Sheets("Sheet2").Cells.Find(What:=(com.Offset(i, 0).Value), LookIn:=xlValues, LookAt:=xlPart)
Set destinationcell = Sheets("Sheet1").Cells.Find(What:=(com.Offset(i, 0).Value), LookIn:=xlValues, LookAt:=xlPart)


'SEE BELOW FOR CODE INSERTED HERE


destinationcell.Offset(0, 1).Value = sourcecell.Offset(0, 1).Value
i = i + 1
Loop Until IsEmpty(com.Offset(i, 0)) And IsEmpty(com.Offset(i + 1, 0))
End Sub


The code loops through the first sheet finding Cells in column A and then searches column a in sheet 2 to locate the coresponding cells and copy values in the cell to the right of that cell over to sheet 1 column b.

I want to change the code so that when the code loops through sheet 1 coumn a, if it finds a cell that is Bold or Empty then it skips to the next count in the loop. I have tried inserting this code but I get an error stating 'object required'

If cell.sourcecell.Font.Bold = True Then
ElseIf cell.sourcecell = "" Then
Else
End If


Any ideas?

[Bob Phillips]

I'm confused. After it finds Commodities on Sheet1, why is it looping for the following rows?

[Bob Phillips]

BTW, do you have a workbook, it always clarifies things.