More VBA Help ??

nutritiouspig

Well-known Member
Joined
Jan 8, 2003
Messages
615
What I am trying to do is come up with a way to have my macro check the contents of my data set for a name match. So for example: I might have five different names (Name_1),(Name_2),etc... I would like to have the macro execute into a sheet that contains that same name, as the sheet name.

Below is what my macro looks like (portion), right now it just goes to a sheet called UM_Output -- which i wont even need if i can have the macro check for a name match (which is in A12, like the example below).

A12 Example: Selected by: Agent Data: TEAM MGR Agent Data Value: Lastname, Firstname

Please let me know if more detail is needed. (And thanks for the help you have all given already!!!)

Cheers
S.

Sheets("UM_Output").Range("A1:K250").Delete
Sheets("UM_Data_Sheet").Range("A:A").Copy
Sheets("UM_Output").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(23, 1), Array(48, 1), Array(52, 1), Array(55, 1), _
Array(61, 1))
Columns("D:E").NumberFormat = "General"
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hi, Im a bit unclear what the end objective is. So you find something then what? Im not sure how the name your looking for in a cell ties in with the sheets name or what the copying is about.

Please explain a bit more and I will try and help you. :biggrin:
 
Upvote 0
I was just on my way back to shorten my question, thanks for the reply.

Lets say:

If A12 = ("Name") then it will copy the entire contents of that sheet, into another sheet that has the same name.

So, my sheet names are:

UM_Data_Sheet (which is where the data starts)
MGR1
MGR2
MGR3
MGR4

So if in the UM_Data_Sheet , A12 has somewhere in the text string MGR1, I would like the whole contents of UM_Data_Sheet copied to MGR1.

I hope that's more clear.

Thank you!
S.
 
Upvote 0
Ok, I think I understand. You wont need a big list of every sheet name, you only need to indicate what sheet you would like the info transferred to.

In fact, you dont even need to put this in a cell if you dont want to. A Input box could come up asking for the sheet name then copy the data.

But what about the destination sheet, wont all the information in there be replaced (i.e. youll lose existing info)?
 
Upvote 0
Here you go :biggrin:

Code:
Sub TfrData()
Dim a As String, Sh As Worksheet, b

Do
a = InputBox("Enter the destination sheet name", _
"Copy data from sheet 'UM_Data_Sheet' to...")

If a = vbNullString Then
    MsgBox "Action cancelled. No data was copied."
    Exit Sub
Else
    On Error Resume Next
    Set Sh = Worksheets(a)
    If Sh Is Nothing Then
    b = MsgBox("You have entered an invalid sheet name. Try again?", vbYesNo + vbCritical)
        If b = vbNo Then
        MsgBox "Action cancelled. No data was copied."
        Exit Sub
        End If
    End If
End If
Loop While Sh Is Nothing

Worksheets("UM_Data_Sheet").Cells.Copy Sh.Range("a1")

End Sub
 
Upvote 0
That is a really cool function. Thank you for taking the time to do that.

I was wondering, would you be able to show me how to intergrate the macro I had into that? I want whatever sheet I select with the input box to receive the formatted data, not the raw data.

Here is the code I have:

Sub UM_Format()

'===Formats Raw Data==='

Sheets("UM_Output").Range("A1:K250").Delete
Sheets("UM_Data_Sheet").Range("A:A").Copy
Sheets("UM_Output").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(23, 1), Array(48, 1), Array(52, 1), Array(55, 1), _
Array(61, 1))
Columns("D:E").NumberFormat = "General"
Range("B29").Cut Destination:=Range("H31")
Range("A28:F30,A1:F26").Delete
Range("H31").Cut Destination:=Range("H2")
Range("A29:F44").Delete
Range("B36").Cut Destination:=Range("H38")
Range("A36:H36").Delete
Range("B87").Cut Destination:=Range("H89")
Range("A71:H87").Delete
Range("B106").Cut Destination:=Range("H108")
Range("A106:H106,A112:H126,A111:H111").Delete
Range("B141").Cut Destination:=Range("H143")
Range("A141:H141,A152:H167").Delete
Range("B176").Cut Destination:=Range("H178")
Range("A176:H176,A193:H208").Delete
Range("B211").Cut Destination:=Range("H213")
Range("A211:H211,A234:H249").Delete
Columns("A:A").Delete
Columns("B:B").Delete

'===Calculates Shrinkage%==='

Range("F34,F69,F104,F139,F174,F209,F244").FormulaR1C1 = "=SUM(R[-32]C[-2]:R[-25]C[-2],R[-23]C[-2]:R[-1]C[-2])"
Range("G244,G209,G174,G139,G104,G69,G34").FormulaR1C1 = "=0.295-RC[-1]"

'===Conditional Formatting==='

Range("F34,F69,F104,F139,F174,F209,F244").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="0.295"
With Selection.FormatConditions(1).Font
.Bold = True
.ColorIndex = 2
End With
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="0.295"
With Selection.FormatConditions(2).Font
.Bold = True
.ColorIndex = 1
End With
Selection.FormatConditions(2).Interior.ColorIndex = 35
'-------------------------
Range("G34,G69,G104,G139,G174,G209,G244").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="0"
With Selection.FormatConditions(1).Font
.Bold = True
.ColorIndex = 1
End With
Selection.FormatConditions(1).Interior.ColorIndex = 35
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="0"
With Selection.FormatConditions(2).Font
.Bold = True
.ColorIndex = 2
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
Range("F34:G34,F69:G69,F104:G104,F139:G139,F174:G174,F209:G209,F244:G244").HorizontalAlignment = xlCenter
End Sub
 
Upvote 0
Hi thats a fair bit of code but I'll help if I can. I would have thought you would have just copied the raw data then did all your formatting on the destination sheet?

If that was the case then you could add the following line to the code I posted which selects the destination sheet...

Sh.Activate

And then follow on in your code from the line ....

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(23, 1), Array(48, 1), Array(52, 1), Array(55, 1), _
Array(61, 1))

Perhaps the simplest way is just to call your other procedure so it runs and take out these lines to do with the copy deletion process...

Sheets("UM_Output").Range("A1:K250").Delete
Sheets("UM_Data_Sheet").Range("A:A").Copy
Sheets("UM_Output").Select
Range("A1").Select
ActiveSheet.Paste

To call the procedure called UM_Format do this...
Call UM_Format


Perhaps something like this...
Code:
Sub TfrData() 
Dim a As String, Sh As Worksheet, b 

Do 
a = InputBox("Enter the destination sheet name", _ 
"Copy data from sheet 'UM_Data_Sheet' to...") 

If a = vbNullString Then 
    MsgBox "Action cancelled. No data was copied." 
    Exit Sub 
Else 
    On Error Resume Next 
    Set Sh = Worksheets(a) 
    If Sh Is Nothing Then 
    b = MsgBox("You have entered an invalid sheet name. Try again?", vbYesNo + vbCritical) 
        If b = vbNo Then 
        MsgBox "Action cancelled. No data was copied." 
        Exit Sub 
        End If 
    End If 
End If 
Loop While Sh Is Nothing 

Worksheets("UM_Data_Sheet").Cells.Copy Sh.Range("a1") 
Sh.Activate 
Call UM_Format

End Sub

Code:
Sub UM_Format() 

'===Formats Raw Data===' 

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ 
FieldInfo:=Array(Array(0, 1), Array(23, 1), Array(48, 1), Array(52, 1), Array(55, 1), _ 
Array(61, 1)) 
Columns("D:E").NumberFormat = "General" 
Range("B29").Cut Destination:=Range("H31") 
Range("A28:F30,A1:F26").Delete 
Range("H31").Cut Destination:=Range("H2") 
Range("A29:F44").Delete 
Range("B36").Cut Destination:=Range("H38") 
Range("A36:H36").Delete 
Range("B87").Cut Destination:=Range("H89") 
Range("A71:H87").Delete 
Range("B106").Cut Destination:=Range("H108") 
Range("A106:H106,A112:H126,A111:H111").Delete 
Range("B141").Cut Destination:=Range("H143") 
Range("A141:H141,A152:H167").Delete 
Range("B176").Cut Destination:=Range("H178") 
Range("A176:H176,A193:H208").Delete 
Range("B211").Cut Destination:=Range("H213") 
Range("A211:H211,A234:H249").Delete 
Columns("A:A").Delete 
Columns("B:B").Delete 

'===Calculates Shrinkage%===' 

Range("F34,F69,F104,F139,F174,F209,F244").FormulaR1C1 = "=SUM(R[-32]C[-2]:R[-25]C[-2],R[-23]C[-2]:R[-1]C[-2])" 
Range("G244,G209,G174,G139,G104,G69,G34").FormulaR1C1 = "=0.295-RC[-1]" 

'===Conditional Formatting===' 

Range("F34,F69,F104,F139,F174,F209,F244").Select 
Selection.FormatConditions.Delete 
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ 
Formula1:="0.295" 
With Selection.FormatConditions(1).Font 
.Bold = True 
.ColorIndex = 2 
End With 
Selection.FormatConditions(1).Interior.ColorIndex = 3 
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ 
Formula1:="0.295" 
With Selection.FormatConditions(2).Font 
.Bold = True 
.ColorIndex = 1 
End With 
Selection.FormatConditions(2).Interior.ColorIndex = 35 
'------------------------- 
Range("G34,G69,G104,G139,G174,G209,G244").Select 
Selection.FormatConditions.Delete 
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ 
Formula1:="0" 
With Selection.FormatConditions(1).Font 
.Bold = True 
.ColorIndex = 1 
End With 
Selection.FormatConditions(1).Interior.ColorIndex = 35 
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ 
Formula1:="0" 
With Selection.FormatConditions(2).Font 
.Bold = True 
.ColorIndex = 2 
End With 
Selection.FormatConditions(2).Interior.ColorIndex = 3 
Range("F34:G34,F69:G69,F104:G104,F139:G139,F174:G174,F209:G209,F244:G244").HorizontalAlignment = xlCenter 
End Sub

hth
 
Upvote 0

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

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
Back
Top