Scan and Copy

innoin

New Member
Joined
May 4, 2017
Messages
22
Hello! I will start by saying that I don't really know anything about coding or VBA...other than copying the help all of you have given me in the past to a new module and connecting that to a button.


So! I'm hoping someone here will find this ridiculously simple and be able to help me. I have to compile A LOT of data and will need to look through thousands of spreadsheets. I'll be doing between one and 20-ish sheets at a time. I have an excel file with some VBA I attached to a button that lets me combine multiple Excel files into one document (puts all sheets onto their own individual tab and then returns me to a "Results" tab).

I want to do the following:


1. Scan across multiple tabs
2. Starting with the first tab, I want to copy F10 and C12 to cells A1 and B1 of the "Results" tab
3. Then search for the first instance of the word "Circle" or "Sphere" in column A (this might not be just "Circle"...it may be Circle1 or Circle A or Sphere One or any variation of other things around the word "Circle" or "Sphere")
4. When the first instance of this word is found, copy it to cell A2 of the "Results" tab
5. Then continue scanning down and look for the word "Diameter" in the same column
6. When it's found, copy the cell to the right of it (for example, if it's on cell A5 then copy B5) to cell B2 of the "Results" tab
7. Then continue scanning for the next instance of the word word "Circle" or "Sphere"
8. Repeat steps 2 through 7 and continue down until the end of the first imported tab
9. Repeat steps 2 through 8 so there's no gaps in data.


I don't know if this is possible or if I even made any sense. Thanks for any help anyone can give me!
 
Last edited:

rpaulson

Well-known Member
Joined
Oct 4, 2007
Messages
1,074
try this: make sure you "results" sheet is the active sheet when you run it.

Code:
Sub do_it()

wr = 1

Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name <> "Results" Then

Cells(wr, "A") = ws.[F10]
Cells(wr, "B") = ws.[C12]
wr = wr + 1

For r = 1 To ws.Cells(Rows.Count, "A").End(xlUp).Row
If InStr(UCase(ws.Cells(r, "A")), "CIRCLE") > 0 Or InStr(UCase(ws.Cells(r, "A")), "SPHERE") > 0 Then
Cells(wr, "A") = ws.Cells(r, "A").Value
wr = wr + 1
End If

If InStr(UCase(ws.Cells(r, "A")), "DIAMETER") > 0 Then
Cells(wr - 1, "B") = ws.Cells(r, "B").Value
End If
Next r

End If

Next ws

End Sub
hth,

Ross
 

innoin

New Member
Joined
May 4, 2017
Messages
22
I just replicated what I will be doing and it seemed to work perfectly! Thank you! I'll let you know if I run into any problems once I actually start running the real spreadsheets tonight.
 

innoin

New Member
Joined
May 4, 2017
Messages
22
Hello, I just tested it and it works almost perfectly. Would it be possible to add something that would skip occurrences of the word "Circle" if the cell next to it is empty? I forgot that mixed throughout the data are random areas with the word "circle" in a sentence with nothing in the B column next to it, so it's pulling that data in as well. Thanks again!
 

innoin

New Member
Joined
May 4, 2017
Messages
22
And hello again! Just wanted to say that I searched around and found something on another board that I added to your code to achieve what I wanted...Kind of roundabout but it works! I think it just searches and deletes the unwanted rows after it's placed on the Results tab if columns B and C are empty. I'll include the code below in case it helps someone who randomly stumbles on this thread. Thanks again, again!

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Columns("B:C").Select
Set rngRange = Selection.CurrentRegion
lngNumRows
= rngRange.Rows.Count
lngFirstRow
= rngRange.Row
lngLastRow
= lngFirstRow + lngNumRows - 1
lngCompareColumn
= ActiveCell.Column
For lngCurrentRow = lngLastRow To lngFirstRow Step -1
If (Cells(lngCurrentRow, lngCompareColumn).Text = "") Then _
Rows
(lngCurrentRow).Delete
Next lngCurrentRow</code>
 

innoin

New Member
Joined
May 4, 2017
Messages
22
Hmmm, sorry for replying to my own post four times...That line didn't work as well as I'd hoped it would. I want to make some small alterations and it deletes rows I don't want deleted once I make those alterations. So, back to the original problem. If you have a solution for not including the circle names if there's nothing in the cell next them, I'd be in your debt! A debt I can't repay because I don't know anything about VBA.
 

rpaulson

Well-known Member
Joined
Oct 4, 2007
Messages
1,074
try this:

Code:
If InStr(UCase(ws.Cells(R, "A")), "CIRCLE") > 0 Or InStr(UCase(ws.Cells(R, "A")), "SPHERE") > 0 And ws.Cells(R, "B") <> "" Then
 

innoin

New Member
Joined
May 4, 2017
Messages
22
Yep, that worked! Thank you!

One more question regarding this if you're still around: What if I wanted to add more features to it? Instead of just searching for "Diameter", could I also have it search for "Roundness" as well? Also, would it be possible to make it pull two cells instead of one if this word is found? For example, could it report cells D and E next to the word "Roundness" into the results columns B and C?
 

Forum statistics

Threads
1,081,981
Messages
5,362,535
Members
400,679
Latest member
alecalec202

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top