Scan and Copy

innoin

New Member
Joined
May 4, 2017
Messages
33
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:

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

rpaulson

Well-known Member
Joined
Oct 4, 2007
Messages
1,103
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
33
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
33
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
33
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
33
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,103
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
33
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,102,872
Messages
5,489,425
Members
407,687
Latest member
NeoSez

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top