Finding specific data fields in worksheets that are different every time - vba

I am trying to collate values from multiple spread sheets I am given. Unfortunately the fields I am interested in are never in the same location, and can have any number of blank cells in between the value I want and the corresponding reference number (that identifies it as the number I want). They are always in the same row as each other though.
For example, I need to find all values that relate to '1. Number of people'. In worksheet 1 '1. Number of people' is in cell B2 and the value is in cell B6. In worksheet 2 these are in C4 and C7 respectively.
I am using 'find' to assign the location of '1. Number of people' to a range, but getting stuck after that.
I think I need to activate that cell, then offset until I find the next non blank cell and select that to copy, but can't work out how to do this.
So far all I have is:
Dim rgFound As Range
Set rgFound = Range("A1:E6").Find("1.Number of people", lookat:=xlWhole)
You can see I have not got very far!
Thanks in advance.

Give this a shot.
Dim rgFound As Range
Set rgFound = Range("A1:E6").Find("1.Number of people", lookat:=xlWhole)
Dim rgValue as Range
If Not rgFound is Nothing Then
If Len(rgFound.Offset(1)) Then 'if the very next row is the next non-blank cell
Set rgValue = rgFound.Offset(1)
Else 'if blanks appear between found and value
Set rgValue = rgFound.End(xlDown)
End If
End If

Related

looping through each COLUMN and finding highlighted cell

I am having difficulty looping through each column before looping through the next row. The number of columns is fixed (A:K) with an unknown number of rows. The goal is to find highlighted cells (no distinct color.. and I figured the best way to do this is to code "If Not No Fill") and copy that whole row to another workbook. This is what I have so far and I am stuck:
Option Explicit
Sub Approval_Flow()
Dim AppFlowWkb As Workbook, ConfigWkb As Workbook
Dim AppFlowWkst As Worksheet, ConfigWkst As Worksheet
Dim header As Range, headerend As Range
Dim row As Long, column As Long
Set AppFlowWkb = Workbooks.Open("C:\Users\clara\Documents\Templates and Scripts\Approval Flow Change Log.xlsx")
Set ConfigWkb = ThisWorkbook
Set AppFlowWkst = AppFlowWkb.Sheets("Editor")
Set ConfigWkst = ConfigWkb.Worksheets("Approval Flows")
With ConfigWkb
Set header = Range("A7").Cells
If Not header Is Nothing Then
Set headerend = header.End(xlDown).row
For row = 7 To headerend
For j = 1 To 11
'if cell is filled (If Not No Fill), copy that whole row to another workbook
End With
End Sub
I am getting an error with the Set headerend line, but I am trying to select the last row to use it in my for loop. I appreciate any help and guidance. Thanks in advance!
You should be able to adapt this to suit your workbooks, see the comments for details
Dim aCell as Range
' Use UsedRange to get the variable number of rows,
' cycle through all the cells in that range
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.UsedRange.Rows.Count)
' Test if fill colour is white (none)
If Not aCell.Interior.Color = RGB(255,255,255) Then
' Insert new row in target sheet (could find last row instead)
ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1").EntireRow.Insert
' Paste entire row into target sheet
aCell.EntireRow.Copy Destination:=ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1")
End If
Next aCell
Alternatively to find the last row, if you know the range is continuous (no blanks) then you can use End(xlDown) like you had done, and like below
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.Range("K1").End(xlDown))
I'd guess you don't want to copy the same row multiple times if you've already copied it. You could do this by keeping an array or string with previously copied row numbers and checking before copying again, or use Excel's unique functions to strip the list down after copying.
Hope this helps.
Aside:
You're using a With block but not taking advantage of it, you need to put a dot . before your Range objects to specify that they're in your With sheet. Like so
Dim myRange as Range
With ActiveSheet
Set myRange = .Range("A1:C10")
End With
You're mixing the types.
It looks like you just want to use the Row that the Header data ends on.
Take out the .Row there, since you're setting headerend to be a cell address, not a specific value. Then change For row = 7 To headerend to For row = 7 To headerend.Row
Or, change Dim Headerend as Range to ...as Long and just do headerEnd = header.End(xlDown).Row (don't use Set)

Excel Database data issue

I have a farily large database of around 2000 people, sheet1 has all of their names and relevant details. Sheet 2 has data pulled on from a site. I would like the data from sheet 2 to auto populate the cells in Sheet 1. Also if the person does not exist in sheet1 to highlight the data it couldnt do. I am so stuck on this.
Sub dup()
Dim cell As Range, cella As Range, rng As Range, srng As Range
Set rng2 = Sheets(2).Range("A2:E2000")
Set rng3 = Sheets(3).Range("A2:E29000")
For Each cell In rng2
For Each cella In rng3
If cella = cell Then
cella.Interior.ColorIndex = 6
' cella.AddComment.Text Text:="duplicate value"
End If
Next cella
Next cell
Set rng2 = Sheets(2).Range("T2:Y2000")
Set rng4 = Sheets(4).Range("A1:F2000")
For Each cell In rng2
For Each cella In rng4
If cella = cell Then
cella.Interior.ColorIndex = 6
' cella.AddComment.Text Text:="duplicate value"
End If
Next cella
Next cell
End Sub
Its hard for me to show as it has a lot of columns not sure how on earth i can show you what im trying to do? :(
Try https://filetea.me/t1sfGPWECvdQqmgVDGtXL4oRQ
Maybe, if you want to do it without vba, you could use the LOOKUP function in the sheet 1's auto populate column. It works like that:
=LOOKUP(sheet1!A2, sheet2!table[a], sheet2!table[b])
This will find the value in the column "b" of the table in sheet2 based on the values of column "a". This will chose the value in the same row were column "a" matches the value in sheet1's A column. Let me know if I wasn't clear enough here.
Then you can use Conditional Formatting rules for the highlight you said. I suggest the COUNTIF function, that will return 0 if no matching value is found in the specified range.
=COUNTIF(A2:A5,A4)
This, for example, cont values in A2:A5 that matches the values in A4.
Also, you will find the conditional formatting tools in the home tab, if you are using excel 2016.
See the link for more information:
Information you may need

Highlight unique values based on another range

Column 1 is in Sheet1 and column 2 is in Sheet2. If the value is not found , then highlight that cell. I am trying to do a vlookup comparing two columns. I think the Syntax is incorrect. Please see my code I was trying below:
Option Explicit
Sub VlookupColoums()
' declarations
Dim lookFor As Range
Dim srchRange As Range
Dim I As Long
Dim vtest As Variant
' start
Set lookFor = Sheets("Sheet1").Range("A13").End(xlUp)
Set srchRange = Sheets("Sheet2").Range("A2").End(xlUp)
vtest = Application.VLookup(lookFor.Rows.Count, srchRange.Rows.Count, 2, False)
' process
For I = 1 To lookFor.Rows.Count
If IsError(vtest) Then
srchRange.Interior.Color = 4
Else
Exit Sub
End If
Next I
End Sub
Assuming you have data on Sheet1!A1:A15 and Sheet2!A1:A10.
Also assuming you want to highlight unique cells (ones withouth at least one identical in the other list) on Sheet2.
Basically you want to format all the cells that if counted on the other list comes up with 0. The steps:
Select all the cells to be evaluated on Sheet2
Go to Home/Styles/Conditional Formatting
Select New Rule, then Use a formula to determine...
Enter this formula: =COUNTIF(Sheet1!$A$1:$A$5,A1)=0
Click on the Format button, and set up a formatting for the unique cells
OK
Profit. :)

Best way to return data from multiple columns into one row?

I have a sheet with just order numbers and another with order numbers and all of the data associated with those order numbers. I want to match the order numbers and transfer all of the available data into the other sheet. I've been trying to use loops and VLOOKUP but I'm having problems (plus I have 116 columns I want to transfer data from so my vlookup expression doesn't look very nice). Any advice would be appreciated!
this is what I have so far and I'm getting an object error.
I don't think it's the right way to go about it in general though.
Dim LookUpRange As Range
Dim row As Range
Set LookUpRange = Worksheets("batches").Range("B4:B1384")
Set row = Worksheets("batches").Range("C:DL")
For Each row In LookUpRange
row.Select
Selection.FormulaArray ="=VLOOKUP(RC[-1],OrderLvl!RC[-1]:R[1380]C[113],{2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,207,108,109,110,111,112,113,114,115},FALSE)"
Next row
End Sub
Please consider this VBA script to resolve your inquiry:
Sub LookupOuput()
Dim OrderNumberColumn As Range
Set OrderNumberColumn = Worksheets("batches").Range("B2:B1384")
Dim LookUpRange As Range
Set LookUpRange = Worksheets("OrderLvl").Range("C:DL")
Dim cell As Range
Dim FindResult As Range
For Each cell In OrderNumberColumn
If Not cell.Value2 = Empty Then
Set FindResult = LookUpRange.Find(what:=cell.Value2)
If Not FindResult Is Nothing Then
cell.Range("A1:DJ1").Value2 = LookUpRange.Rows(FindResult.row).Value2
End If
End If
Next cell
End Sub
Basically searches for each Order Number in the first sheet on the second sheet. This outputs (if search term exists) the cell that that string is found which we later refer to its row number to output the whole row to the first sheet. Cheers,
A regular VLOOKUP may be able to give you what you need, if you use a small trick...
Insert a row above the data table, and put sequential numbers in
each cell of that row. (ie, A1 = 1, B1 = 2, C1 = 3, etc...)
Do the same thing on your blank table.
Assuming that your first order number is in cell A2, put the following formula into B2: =VLOOKUP($A2,[other sheet name]!$A$1:$DZ$5000,B$1,0)
Drag this formula across all 116 columns, then down all however many rows you've got.
You'll need to adjust the ranges, obviously, but make sure that your lookup array starts in column A. (or alternatively, that your numbers start in the same column as the first column in your array.) Adding the numbers along the top allows you to change what column of the array you're referencing, just by dragging the cell formula.

How to build non-consecutive ranges of rows based on cell contents?

I'm just getting started with VBA for Excel. I used VB and Java in college nearly ten years ago and was competent with it then, but am essentially starting over. (Um, not like riding a bike.)
I am trying to understand the methods to build a range that isn't just declared as A1:J34 or whatever. My Googling is challenged in that when searching for 'range' and terms that indicate what I seek, I get an avalanche of hits far more advanced than what I need, mostly hits that don't even address the basic summary info I need.
So, here's the basics of it:
Excel 2011 on Mac.
The sheet has data from A to M, down to 1309.
It's a repeating pattern of heading rows followed by data rows. Ugh. Seems like the person creating the sheet was more thinking about printing from the sheet than the organisation of the data. I need to clean it and 3 more like it up to use in a pivot table, and it's useless in this silly repeating layout.
Heading rows are as follows:
Last Name, First Name, then 10 date cells.
Data rows under the headings are the names, of course, and then a 1 or 0 for attendance.
Anywhere from 20 to 30 names under each heading. Then it repeats. And the dates change every few sets, picking up where the last set left off.
What I need to do right now:
I'm trying to assemble a range into a range variable by adding all the rows beginning with a specific value (in column A). In my case that value is the string "Last Name", so I can have the range variable holding all the cells in all rows that begin with "Last Name". This will then capture all the cells that need to be in date format. (I'm doing it so I can then make sure the date headings are all actually IN date format - because they are NOT all in date format now, many are just 'General' cells.)
My questions:
When telling a range object what it's range IS, how do you feed it cells/rows/columns that are not just a block defined by start and end cells entered by the person writing the code but based on row criteria? Eg: Create a Range that has rows 1, 34, 70, 93, and 128 from columns A to I based on presence of "First Name" in A.
What are the most common methods to do this?
Which of these is best suited to my need and why?
Here's a working example that demonstrates finding the "Last Name" rows, contructing a range object that includes all those rows, and then iterating through that object to search for non-date values. The code could be speeded up greatly by reading the data range into an array of variants and then searching the array for both the last name rows and the "bad dates" within those rows. This is especially true if you have a very large number of rows to check.
Sub DisjointRng()
Dim checkCol As String, checkPattern As String
Dim dateCols()
Dim lastCell As Range, usedRng As Range, checkRng As Range
Dim cell As Variant
Dim usedRow As Range, resultRng As Range, rngArea As Range
Dim i As Long, j As Long
checkCol = "A" 'column to check for "Last Name"
checkPattern = "Last*"
dateCols = Array(3, 5) 'columns to check for date formatting
With Worksheets("Sheet1")
'find the bottom right corner of data range; we determine the used range
'ourselves since the built-in UsedRange is sometimes out-of-synch
Set lastCell = .Cells(.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
Set usedRng = .Range("A1:" & lastCell.Address)
'the column of values in which to look for "Last Name"
Set checkRng = .Range(checkCol & "1:" & checkCol & usedRng.Rows.Count)
End With
'step down the column of values to check for last name & add
'add found rows to range object
For Each cell In checkRng
If cell.Value Like checkPattern Then
'create a range object for the row
Set usedRow = Intersect(cell.EntireRow, usedRng)
If resultRng Is Nothing Then
'set the first row with "Last Name"
Set resultRng = usedRow
Else
'add each additional found row to the result range object
Set resultRng = Union(resultRng, usedRow)
End If
End If
Next cell
For Each rngArea In resultRng.Areas
'if found rows are continguous, Excel consolidates them
'into single area, so need to loop through each of the rows in area
For i = 1 To rngArea.Rows.Count
For j = LBound(dateCols) To UBound(dateCols)
If Not IsDate(rngArea.Cells(i, dateCols(j))) Then
'do something
End If
Next j
Next i
Next rngArea
End Sub
You can use the Union operator, like this
Dim r As Range
Set r = Range("A1, A3, A10:A12")
or this
Set r = Union(Range("A1"), Range("A3"), Range("A10:A12"))
You can the iterate this range like this
Dim cl as Range
For Each cl in r.Cells
' code cell cl
Next
or this
Dim ar as Range
For each ar in r.Areas
' code using contiguous range ar
For each cl in ar.Cells
' code using cell cl
Next
Next