PDA

View Full Version : [SOLVED] If a word in a cell in col A matches the name of a worksheet, move row to that sheet



1819
06-26-2016, 04:17 AM
The code below comes from
http://stackoverflow.com/questions/24632623/move-row-to-another-worksheet-where-cell-equals-worksheet-name.

It works to move rows that match the name of a worksheet to that worksheet.

Please could someone suggest how to amend it to achieve this: (in pseudocode)

If a cell contains a word which matches the name of worksheet, move the row to that worksheet.

Work in the order of the worksheets so that if there is a duplicate, move to the first match.

So if you had "Vote Leave or Remain" in the cell, and "Leave" and "Remain" as worksheets, the row would be moved to "Leave".

Ideally I would like the code to be able to cope with dynamic worksheet names (that is, not having to write in the worksheets' names in the code)




Sub Main()
Sheets("All Data").Activate
Range("A2").Activate
Dim SheetToPaste As String
Do While ActiveCell.Value <> ""
Select Case ActiveCell.Value
Case "Hoja2"
SheetToPaste = "Hoja2"
Case "Hoja3"
SheetToPaste = "Hoja3"
Case Else
SheetToPaste = "Mismatch"
End Select
ActiveCell.EntireRow.Copy
Sheets(SheetToPaste).Activate
Range("A2").Activate
ActiveCell.EntireRow.Insert
Application.CutCopyMode = False
Sheets("All Data").Activate
ActiveCell.EntireRow.Delete
Loop
End Sub


Thanks!

snb
06-26-2016, 04:31 AM
Sub M_snb()
sn=sheets("all data").columns(1).specialcells(2,2)
redim sp(sheets.count)

for j=1 to sheets.count
sp(j)=sheets(j).name
next

for j=1 to ubound(sn)
for jj=1 to ubound(sp)
if instr(sn(j,1),sp(jj)) then exit for
next
if jj<= ubound(sp) then sheets(sp(j)).cells(rows.count,1).end(xlup).offset(1).resize(,ubound(sn,2)) =application.index(sn,j)
next
End Sub

1819
06-26-2016, 05:34 AM
Thanks very much for your rapid reply.

I'm getting a "Compile error: variable not defined" at "sn" in the extract below:



sn=sheets("all data").columns(1).specialcells(2,2)


Please could you possibly suggest a fix?

Thanks.

snb
06-26-2016, 08:14 AM
Remove option explicit.

1819
06-26-2016, 12:33 PM
Many thanks. I am now getting "Run time error 13: type mismatch" at this point:



Sheets(sp(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(sn, 2)) = Application.Index(sn, j)


Please could you suggest a solution?

mdmackillop
06-26-2016, 02:00 PM
try

Set sn=sheets("all data").columns(1).specialcells(2,2)

1819
06-26-2016, 03:35 PM
try

Set sn=sheets("all data").columns(1).specialcells(2,2)

Thanks but the same error ("Run time error 13: type mismatch") now appears at



For j = 1 To UBound(sn)


Any ideas?

snb
06-27-2016, 01:26 AM
You have to analyse the code, debug & adapt it if necessary yourself.
You shouldn't use code you don't understand.

1819
06-27-2016, 07:04 AM
You have to analyse the code, debug & adapt it if necessary yourself.
You shouldn't use code you don't understand.

That's an unnecessary comment.

We all have much to learn. We learn by doing things we have not done before.

I was grateful that you offered an answer, but it didn't work.

So it was reasonable to ask for further help.

What's the point of a forum if people put up wrong answers and then walk away?

snb
06-27-2016, 07:21 AM
Nothing wrong in the answer.....

mdmackillop
06-27-2016, 10:16 AM
Posting a sample workbook allows responders to test their code. Without this, you need to do your own debugging.

1819
06-27-2016, 11:37 AM
Posting a sample workbook allows responders to test their code. Without this, you need to do your own debugging.

I'm sorry I did not do that in the first place.

I've attached a specimen file in which worksheet "Commentary" has data in column A.

The aim is to move all rows containing the names of the other worksheets - here Texas and Germany - to those worksheets.

I've included the macro proposed above but I'm getting a runtime error as described.

Thanks

16486

mdmackillop
06-27-2016, 11:53 AM
Option Explicit
Sub M_snb()
Dim sn, sp()
Dim j As Long, jj As Long
sn = Sheets("Commentary").Columns(1).SpecialCells(2, 2)
ReDim sp(Sheets.Count)

For j = 1 To Sheets.Count
sp(j) = Sheets(j).Name
Next

For j = 1 To UBound(sn)
For jj = 1 To UBound(sp)
If InStr(sn(j, 1), sp(jj)) Then Exit For
Next
If jj <= UBound(sp) Then Sheets(sp(jj)).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(sn, 2)) = Application.Index(sn, j)
Next
End Sub

snb
06-27-2016, 12:14 PM
Your description didn't match your file.

Put this in the sheet 'commentary' codemodule:


Sub M_snb()
sn = Application.Transpose(Sheets("Commentary").cells(1).CurrentRegion.Columns(1).Value)

For Each sh In Sheets
sp =Filter(sn, sh.Name)
If UBound(sp) > -1 Then sh.Cells(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
Next
End Sub

NB. remove all 'option explicit'

1819
06-27-2016, 03:34 PM
Thank you - both solutions worked. This is excellent - you will save me a lot of tedious work.

(I could only give out one rep at a time. I'll come back).