VBA Match Cell Value to Worksheet Name and copy

Bablu · Jan 19, 2010

Hi,

I have some data and I would like to put an If condition to copy to worksheet if a cell value match to worksheet.

For example, If range("C2"). value match a Worksheet name then I would like to copy Range("A1

.currentregion and paste to that particular worksheet.

So on Sheet1 cell C2 I have a value of Credit Swaps and I also have a worksheet name Credit Swaps. If the cell value match the worksheet name then I want to copy sheet1 (currentregion) and paste to Finalrow + 6 on Column N of the worksheet (credit Swaps)

Any lead would be appreciated. I can do most of it but I don't know how to match the cell value to worksheet unless I create each individually which defeats the purpose.

Thanks,

Bablu

alvinwlh · Nov 21, 2011

Hi,

Let see whether is the code below is what you want:

I have change the codes that highlighted in red.

Code:

Sub Employee_search()
Dim sh As Worksheet
x = 2
 
Do
'Get the agent name from the Employee Roster
With Sheets("Employee_Roster")
    Agent_name = .Range("A" & x).Value
End With
 
'Set the variable sh to the Agenst's tab
On Error Resume Next
Set sh = Sheets(Agent_name)
On Error GoTo 0
 
'Check the existance of the Agent's Tab
'Do the following only when the Agent's Tab exist
If Not sh Is Nothing Then
    With Sheets("Sales")
        'Find the Agent name in the Sales Tab --> Range D:E
        Set c = .Range("D:E").Find(Agent_name, LookIn:=xlValues, lookat:=xlWhole)
        [COLOR=red]i = 3[/COLOR]
        If Not c Is Nothing Then
            'If Agent's name found then record the first address
            firstAddress = c.Address
            Do
                'Copy the whole row after row found
                .Rows(c.Row).copy
 
                With Sheets(Agent_name)
                    'Paste the Copied row to the Agent's Tab --> row 3
                    .Rows([COLOR=red]i[/COLOR]).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    [COLOR=red]i = i + 1[/COLOR]
                End With
 
                'Check again the Agent's name in the Sales Tab
                Set c = .Range("D:E").FindNext(c)
 
            'Loop the check until all apperance of Agent's name found in the sales Tab
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
Else
    'Msg Pop out if the Agent's tab does not exist
    R = MsgBox("Sheets " & Agent_name & " does not Exists", vbOKOnly)
End If
 
'Reset the variable sh
Set sh = Nothing
x = x + 1
'Loop back to get a new agent's name in Employee Roster
Loop While Sheets("Employee_Roster").Range("A" & x).Value <> ""
 
End Sub

Peter_SSs · Nov 21, 2011

joe

Here is my interpretation of what you want. Test on a copy of your workbook.

This copies (should) all the rows for an agent at once.

 Sub Split_Agents() Dim Crit As Range, Dest As Range Dim Agents Dim i As Long Dim wsA As Worksheet Dim CurrAgent As String, Invalid As String Const frmlabase As String = "=OR(D2=""#"",E2=""#"")" Application.ScreenUpdating = False With Sheets("Agent_Roster") Agents = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value End With With Sheets("Sales").UsedRange Set Crit = .Offset(, .Columns.Count).Resize(2, 1) For i = 1 To UBound(Agents, 1) CurrAgent = Agents(i, 1) If Len(CurrAgent) > 0 Then Set wsA = Nothing On Error Resume Next Set wsA = Sheets(CurrAgent) On Error GoTo 0 If wsA Is Nothing Then Invalid = Invalid & vbLf & CurrAgent Else Set Dest = wsA.Range("A" & wsA.Rows.Count).End(xlUp).Offset(1) Crit.Cells(2, 1).Formula = _ Replace(frmlabase, "#", Agents(i, 1), 1, -1, vbTextCompare) .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Crit, _ CopyToRange:=Dest, Unique:=False wsA.Rows(Dest.Row).Delete End If End If Next i Crit.ClearContents End With Application.ScreenUpdating = True If Len(Invalid) > 0 Then MsgBox "Agent sheets not found:" & Invalid End If End Sub

joe_pilgrim · Nov 21, 2011

alvinwlh - I believe that adjustment did it! I'd have to manually check to see if the row count match to the MACRO. Otherwise, I really appreciate it!

alvinwlh · Nov 21, 2011

joe_pilgrim said:
alvinwlh - II'd have to manually check to see if the row count match to the MACRO.

Hi Joe,

Don't quite understand the above statment.

What help do you need from here?

Thanks
Alvin

joe_pilgrim · Nov 22, 2011

alvinwlh - i say that because for certain agents, it is duplicating. Also, can I make a dialogue box pop-up to enter in the "Sales" tab, if possible?

Thanks in advance!

Peter_SSs · Nov 22, 2011

Joe

Did you test my code?

joe_pilgrim · Nov 22, 2011

Peter - thank you for your assistance as your MACRO also works as well. However, it also creates some duplicates. Is there any way to get them not to duplicate, if possible?

Also, I'd like to create a dialogue box indicating me to enter in the "Sales" tab, if possible?

Thanks for the suggestions and assistance!

JP

alvinwlh · Nov 22, 2011

Hi Joe,

Is this the dialog box that looking for?

Code:

Sub Employee_search()
 
Dim sh As Worksheet
 
x = 2
Do
 
With Sheets("Employee_Roster")
    Agent_name = .Range("A" & x).Value
End With
 
On Error Resume Next
Set sh = Sheets(Agent_name)
On Error GoTo 0
 
If Not sh Is Nothing Then
    With Sheets("Sales")
        Set c = .Range("D:E").Find(Agent_name, LookIn:=xlValues, lookat:=xlWhole)
        i = 3
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                .Rows(c.Row).copy
                [COLOR=red]If i >= 4 Then R = MsgBox("Duplicate x" & i - 3 & " : " & Agent_name, vbOKOnly)[/COLOR]
                With Sheets(Agent_name)
                    .Rows(i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    i = i + 1
                End With
                Set c = .Range("D:E").FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
Else
    R = MsgBox("Sheets " & Agent_name & " does not Exists", vbOKOnly)
End If
 
Set sh = Nothing
x = x + 1
 
Loop While Sheets("Employee_Roster").Range("A" & x).Value <> ""
End Sub

I would suggest you create another tab called: "Duplicate"

You can try the code below to records all the duplicate agents in Sales and the number of duplicates:

Code:

Sub Employee_search2()
Dim sh As Worksheet
 
[COLOR=red]Sheets("Duplicate").Range("A1:B" & Rows.count).ClearContents[/COLOR]
 
x = 2
 
Do
 
With Sheets("Employee_Roster")
    Agent_name = .Range("A" & x).Value
End With
 
On Error Resume Next
Set sh = Sheets(Agent_name)
On Error GoTo 0
 
If Not sh Is Nothing Then
    With Sheets("Sales")
        Set c = .Range("D:E").Find(Agent_name, LookIn:=xlValues, lookat:=xlWhole)
        i = 3
        [COLOR=red]Last_row = Sheets("Duplicate").Range("A" & Rows.count).End(xlUp).Row + 1[/COLOR]
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                .Rows(c.Row).copy 
[COLOR=red]                If i >= 4 Then[/COLOR]
[COLOR=red]                  With Sheets("Duplicate")[/COLOR]
[COLOR=red]                      .Range("A" & Last_row).Value = Agent_name[/COLOR]
[COLOR=red]                      .Range("B" & Last_row).Value = i - 2[/COLOR]
[COLOR=red]                  End With[/COLOR]
[COLOR=red]                End If[/COLOR]
                With Sheets(Agent_name)
                    .Rows(i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    i = i + 1
                End With
                Set c = .Range("D:E").FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
Else
    R = MsgBox("Sheets " & Agent_name & " does not Exists", vbOKOnly)
End If
 
Set sh = Nothing
 
x = x + 1
Loop While Sheets("Employee_Roster").Range("A" & x).Value <> ""
 
End Sub

Peter_SSs · Nov 23, 2011

joe_pilgrim said:
Peter - thank you for your assistance as your MACRO also works as well. However, it also creates some duplicates. Is there any way to get them not to duplicate, if possible?

Are you saying that if a particular agent's name appears in more than 1 row on the 'Sales' sheet, that you only want, 1 of those rows transferred to the particular agent's sheet?

- If so, which row should we choose to move? Or will they all be identical for that agent?

- If not, can you explain in more detail what you mean by "it also creates some duplicates"? Perhaps some small dummy data sample might help explain.

Also, I'd like to create a dialogue box indicating me to enter in the "Sales" tab, if possible?

What is this for?
Are there other sheet names that you might want to search for agent names in instead of 'Sales'?

TerryHogarth21 · Mar 21, 2012

I have a similar question onto this topic.

Below is the set of data (say it is on a sheet "Data")

A B C

5 Sheet 1 A5
4 Sheet 2 A8
6 Sheet 4 A7
9 Sheet 7 A9

Column A = Data Value being copied
Column B = Sheet to copy to
Column C = The cell of the sheet(column B) to copy to. (The column will always be constant - Column A, but not row)

How would one loop through column A in VBA of the "Data" Sheet and copy whatever is in A into the destination (Sheet, Cell) that referenced in Column B & C?

Thanks

VBA Match Cell Value to Worksheet Name and copy

Bablu

Board Regular

alvinwlh

Active Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

joe_pilgrim

Board Regular

alvinwlh

Active Member

joe_pilgrim

Board Regular

Peter_SSs

MrExcel MVP, Moderator

joe_pilgrim

Board Regular

alvinwlh

Active Member

Peter_SSs

MrExcel MVP, Moderator

TerryHogarth21

Board Regular

Similar threads

Forum statistics

Share this page

VBA Match Cell Value to Worksheet Name and copy

Board Regular

Active Member

Excel Facts

MrExcel MVP, Moderator

Board Regular

Active Member

Board Regular

MrExcel MVP, Moderator

Board Regular

Active Member

MrExcel MVP, Moderator

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock