Code to compare each cell in a column to every cell in another column - vba

I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!

Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA

Related

=LEFT(H2,5) To show data for all rows and stop at last row of data

Hi could someone enlighten me with some VBA code to insert formula =LEFT(H2,5) into column M and then stop at the last row of data.
The data it will be referencing will be inserted from the web so when i refresh the data pull the rows could be more or less so it can't be a fixed without using VB
Thanks
Rhys
You don't need a loop for this:
Sub qwerty()
Dim N As Long, r As Range
N = Cells(Rows.Count, "H").End(xlUp).Row
Set r = Range("M2:M" & N)
r.Formula = "=LEFT(H2,5)"
End Sub
You will find that the addresses in the formulas adjust just like in copy/paste.
Would a while loop work for you?
Dim i As Integer
i = 2 'starting row number
While Cells(i, 1).Value <> "" 'Empty row
Cells(i, 13).Formula = "=LEFT(H2,5)" 'replace this with something for that row, concatenating i to H will work i think.
i = i + 1
Wend
You'll also want to put this code to whenever the data is refreshed so it inserts the formula to all rows again.
Dim x As Long
x = Application.CountA(ActiveSheet.Columns(13))
ActiveSheet.Cells(2, 13) = "=LEFT(H2,5)"
ActiveSheet.Cells(2, 13).Resize(x - 1).Formula = ActiveSheet.Cells(2, 13).Formula
use excel function CountA to get the total number of row that you need to populate and assign that number to x
then put the actual formula on cells M2 then copy the formula until the last row using resize function

VBA Excel word search and copying formulas

I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.

Looping until blank column

I am putting together some VBA code which i think needs a loop. Loops are often my biggest weakness with VBA and I need some assistance.
I have a text file which i import into an excel spreadsheet. The length of how many columns and rows and down will vary day to day.
For example today's file might have data in columns A - H, tomorrow it might be A : P. Each typical row count will be around the 200 mark, so not to long.
In essence im trying to make one long list in column A from all the data spread over multiple columns.
Im looking for a loop that checks if the column has data in it, if it does it then copies the data into the bottom of the data in column A.
So for illustration purposes say the data goes out to column G, it will copy B1, xl down, find the first empty row in A and paste, then do the same for C, stopping after column G.
I hope I’ve been clear when writing this.
Thanks in advance
Matt
You first want to loop over all columns. So a FOR loop from column B to LastColumn (which there is a function for.) Then you want to loop through all rows within that column to find the first empty row, and then substract one to arrive at the last column with data.
If Cells(row,col) = "" Then
LastRowCopy = row -1
Then you want to copy everything to A1, and keep track of the last row you posted in. So you want to have a variable that counts. Something like:
LastRowPaste = LastRowPaste + row
I could write the code for it, but perhaps you learn more by figuring it out yourself.
Edit: Also perhaps an interesting read on finding last rows and or columns is this: http://www.rondebruin.nl/win/s9/win005.htm
Edit2: You could ofcourse also use the same for finding the last column as the method I used for finding the last row. Then you just loop through the columns and see if:
If Cells(1, col) = "" Then
LastCol = col -1
Edit3:
I wrote out the entire code:
Sub copypaste()
Dim LastRowCopy As String
Dim LastRowPaste As String
Dim LastCol As String
Dim col As Integer
Dim row As Integer
LastCol = ActiveSheet.UsedRange.Columns.Count
LastRowCopy = ActiveSheet.UsedRange.Rows.Count
LastRowPaste = ActiveSheet.UsedRange.Rows.Count
For row = 1 to LastRowPaste
If Cells(row, 1) = "" Then
LastRowPaste = row
Exit For
End if
Next row
For col = 2 To LastCol
If Application.WorksheetFunction.CountA(Columns(col)) = 0 Then
LastCol = col -1
End If
Next col
For col = 2 To LastCol
For row = 1 To LastRowCopy
If Not Cells(row, col) = "" Then
Cells(LastRowPaste, 1) = Cells(row, col)
LastRowPaste = LastRowPaste + 1
End If
Next row
Next col
End Sub

Excel search for empty cells, check conditions, write text

I have been doing some basic VBA programming in Excel 2010 but I have been struggling with this challenge for some time. Basically, I have a sheet that is formatted like this (It actually has 62 columns and rows=# of days in the given month):
Column A will be hidden but is used in a few formulas.
Row 15 shows whether or not the station is open 24/7(all) or only Monday-Friday(M-F).
the values presented are arbitrary counts. However, a blank count represents a problem unless... the station is M-F and
I need to get my code to identify a station that is open M-F and then fill in any particular Sat. or Sun (for that station) with the word "closed." then search for the next station that is M-F and repeat the process.
Initially I was having my code start with an actual value and then use several activecell.offset functions to find empty cells and then check conditions but I couldn't get it to work out. Then I tried to check from the station name or the schedule row but I couldn't get the multiple if/nested offset statements to work either.
I would really appreciate any help or insight you could provide that would show me the best approach. I don't really need the code that does it I just need a pseudo code walk-through unless you are kind enough to write out the code.
Thanks for your help!
I had a similar problem I worked out before. I modified it to your spreadsheet:
Dim d As Long, s As Long
d = 1 'weekdays column
s = 40 'status row
Dim r As Long, c As Long
r = ActiveSheet.Cells(Rows.Count, d).End(xlUp).Row
c = ActiveSheet.Cells(s, Columns.Count).End(xlToLeft).Column
Dim i As Long, cell As Range
i = 0
Dim days() As Long
For Each cell In Range(Cells(1, d), Cells(r, d))
If cell.Value = "Sat" Or cell.Value = "Sun" Then
ReDim Preserve days(i)
days(i) = cell.Row
i = i + 1
End If
Next cell
For Each cell In Range(Cells(s, 1), Cells(s, c))
If cell.Value = "M-F" Then
For i = LBound(days) To UBound(days)
Cells(days(i), cell.Column).Value = "closed"
Next i
End If
Next cell

Extract data from indeterminate range size in Excel

I'm new to VBA, and I'd love some help.
I have a spreadsheet that has a range that will always have 10 columns, but could have X amount of rows. I'm trying to write a VBA script that will iterate over this range and extract the values out of each cell.
For example, if I have 2 rows I need A1, B1, C1..J1 and then I need A2, B2, C2...J2. The next time I could have 5 rows and then another time 3.
How do I setup my loop to make this work?
something like
Dim lastRow as long
lastRow = UsedRange.Rows.Count 'or some other way of determining the last row used
for i = 1 to lastRow 'loop through all used rows
'ActiveSheet.Cells(i, 1).value 'column A
'ActiveSheet.Cells(i, 2).value 'column B
'ActiveSheet.Cells(i, 3).value 'column C
next i
You could also use a dynamic named range and loop through that. See this link or google for better examples. Dynamic name ranges are powerful, especially for charts.
For your example you would set the name range reference to;
=OFFSET(Sheet1!$A$1,0,0,COUNT(Sheet1!$A:$A),10) '10 is the width and will go to column J
assuming that column A will have the true max row of the table.
Then;
Dim arr() As Variant
arr = Range("YourRangeName")
For x = 1 To UBound(arr,1) 'Finds the max number of rows in the array, UBound(arr,2) finds the total columns.
'Do some code here where x steps through the array arr
' = arr(x, 1) 'column a
' = arr(x,2) 'column b
' = arr(x,3) ....
Next x
It's almost always better/faster to process as much as you can in code, i.e. assigning a range in Excel to an Array then loop through the array rather than referencing cells (especially in a loops).