Need macro help, please

wilkisa

Well-known Member
Joined
Apr 7, 2002
Messages
660
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
Our company PCs are locked down and I cannot install the HTML maker so this is the best I can do.


I am trying to create a macro that will find "Type III" in column B on the Data sheet. I then want it to return the remaining contents of the same cell after the word "Variable". Those contents are passed to a variable called ACTIVITY. The contents should then be copied/pasted to the Means Table sheet in the first cell of the table, which is cell B7. I then need to go back to the Data sheet and send the cursor down 5 rows and right 5 columns. I need it to copy the value in that cell and paste it in the Means Table in the first cell in column I in the table, I7. The macro needs to do this for every instance of "Type III" in the Data sheet, which has thousands of rows of data.

Below is the text of the macro I have started. I know I am way off because I don't want it to always use cell B87 in the Activity statement. I also don't know exactly how to loop.

Sub FindTypeIII()
'
' FindTypeIII Macro
'
Dim Activity As String
Dim PValue As Single

Sheets("Data").Activate
'Tell Excel what to find
Cells.Find(what:="Type III", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'Extract the remaining text after the word "Variable"
Activity = Mid(Range("B87"), InStr(Range("B87"), "Variable") + 9, Len(Range("b87")) - InStr(Range("b87"), "Variable"))
Activity.Copy
Sheets("Means Table").Select
Set Activity = Sheets("Means Table").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
ActiveSheet.Paste


Would someone please give me a hand?
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Not tested, but try substituting the find code and the line after with the following

Code:
    Set myRange = Cells.Find(what:="Type III", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Extract the remaining text after the word "Variable"
myText = myRange.Value
Activity = Mid(myText, InStr(myText, "Variable") + 9, Len(myText) - InStr(myText, "Variable"))
As for looping, you'll need to be more specific as to what you need to loop and why.
 
Upvote 0
Not tested, but try substituting the find code and the line after with the following

Code:
    Set myRange = Cells.Find(what:="Type III", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Extract the remaining text after the word "Variable"
myText = myRange.Value
Activity = Mid(myText, InStr(myText, "Variable") + 9, Len(myText) - InStr(myText, "Variable"))
As for looping, you'll need to be more specific as to what you need to loop and why.

Thank you, Weaver, for your reply. I have modified my code but now I am getting "object required" error on the MyRange line.

As far as the loop is concerned, I need this macro to find the first "Type III" and then copy the rest of the text in the cell and paste it in the Means Table sheet. The macro will then go back to the Data sheet, go down 5 rows from the Type III and then 5 columns to the left. Copy the value in that cell and put it in the Means Table in the first space in Column I. The macro should then do the same steps with every Type III it finds in the worksheet.

Can you help further, please?
 
Last edited:
Upvote 0
Can someone please help? I'm not good enough with VBA to figure out my problem.
 
Upvote 0
Code:
activity.copy
isn't valid, as you can't copy a string in this way.
Code:
Sheets("Means Table").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).value=activity
would accomplish what you're after here

This probably isn't the best way to do it and if you need this operation to repeat, then there are some fundamental changes.
 
Upvote 0
Hope this helps - a little tricky to test without sample data
Code:
Option Compare Text 'this line removes case sensitivity in text comparisons
Sub findTypeIII()
    Dim src As Worksheet, dst As Worksheet, activity As String
    Dim myRange As Range, addr As String
    Set src = Sheets("data")
    Set dst = Sheets("means table")
    Set myRange = src.Cells.Find(what:="Type III", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    'if nothing found then don't bother doing anything else
    If Not myRange Is Nothing Then
        'capture location of first instance of string
        addr = myRange.Address
        Do
            'Extract the remaining text after the word "Variable"
            myText = myRange.Value
            activity = Mid(myText, InStr(myText, "Variable") + 9, 2 ^ 16)
            With dst.Range("B" & Rows.Count).End(xlUp).Offset(1)
                .Value = activity
                'get the value offset 5 row & 5 cols
                'and insert it 7 cols to the right (I)
                .Offset(, 7).Value = myRange.Offset(5, 5).Value
            End With
            'find the next one
            Set myRange = src.Cells.FindNext(myRange)
            'loop until we're back where we started
        Loop Until myRange.Address = addr
    End If
End Sub
 
Last edited:
Upvote 0
I'm sorry, Weaver, I have been out of the office. Yes, your macro works and I have been able to modify it to fit my data.

Thank you so much for your help. I and my user truly appreciate it.
 
Upvote 0
I'm sorry, Weaver, I have been out of the office. Yes, your macro works and I have been able to modify it to fit my data.

Thank you so much for your help. I and my user truly appreciate it.
No problem. Glad to hear it all worked out.
 
Upvote 0

Forum statistics

Threads
1,224,603
Messages
6,179,855
Members
452,948
Latest member
UsmanAli786

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